Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1692to1696
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

SaveAs-Funktion

SaveAs-Funktion
12.05.2019 10:12:13
Anja
Hallo zusammen,
ich möchte eine Datei auf einen USB-Stick speichern. Da je nach Computer sich das Laufwerk ändert, muss ich vorher das Laufwerk ausfindig machen.
Alles funktioniert soweit, allerdings wenn die Datei bereits vorhanden ist und Excel die Abfrage stellt:
....Datei vorhanden. Soll sie ersetzt werden? und ich auf "Nein" klicke, kommt folgende Fehlermeldung:
Laufzeitfehler 1004
Die Methode "SaveAs" für das Objekt "Worksheet" ist fehlgeschlagen.
Wie kann ich diesen Fehler umgehen?
Vielen Dank schon mal.
VG
Anja (VBA-Anfänger:-)
Hier der Code:
Private Sub CommandButton12_Click()
Dim FsyObjekt As Object, DrvObject As Object, Drv As Object
Dim DrvType As Object, USBPfad As String
Set FsyObjekt = CreateObject("Scripting.FileSystemObject")
Set DrvObject = FsyObjekt.Drives
For Each Drv In DrvObject
Set DrvType = FsyObjekt.GetDrive(Drv.Path)
Select Case DrvType.DriveType
Case 1: USBPfad = Drv.Path ' & " Removable"
End Select
Next Drv
ActiveWorkbook.SaveAs (USBPfad & "\Judo" & "\Waage U10w.xlsm")
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: SaveAs-Funktion
12.05.2019 10:52:12
Nepumuk
Hallo Anja,
teste mal:
Private Sub CommandButton12_Click()
    Dim FsyObjekt As Object, DrvObject As Object
    Dim DrvType As Object, USBPfad As String, strPath As String
    
    Set FsyObjekt = CreateObject("Scripting.FileSystemObject")
    Set DrvObject = FsyObjekt.Drives
    
    For Each DrvType In DrvObject
        If DrvType.DriveType = 1 Then ' & " Removable"
            USBPfad = DrvType.Path
            Exit For
        End If
    Next DrvType
    
    Set DrvType = Nothing
    Set DrvObject = Nothing
    Set FsyObjekt = Nothing
    
    If USBPfad <> vbNullString Then
        strPath = USBPfad & "\Judo" & "\Waage U10w.xlsm"
        If Dir$(strPath) <> vbNullString Then
            If MsgBox("Die Datei ist schon vorhanden." & vbLf & vbLf & _
                "Überschreiben?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then
                Exit Sub
            Else
                Call Kill(strPath)
            End If
        End If
        Call ThisWorkbook.SaveAs(strPath)
    Else
        Call MsgBox("Kein USB-Stick gefunden", vbExclamation, "Hinweis")
    End If
End Sub

Gruß
Nepumuk
Anzeige
AW: SaveAs-Funktion
12.05.2019 11:27:17
Anja
Hallo Nepumuk,
vielen Dank wieder einmal an Dich!!!
Das funktioniert super!
Viele Grüße
Anja

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige