SaveAs-Funktion

Forumthread: 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

AW: SaveAs-Funktion

12.05.2019 10:52:12

Nepumuk
AW: SaveAs-Funktion

12.05.2019 11:27:17

Anja

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

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

Beliebteste Forumthreads (12 Monate)

Forumthread: SaveAs-Funktion

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

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread