Office: VBA - BackUp-Speichern - Code funktioniert nicht

Hallo in die Runde,

seit etwa einem Jahr benutze ich in einer Datei ein Makro um automatische BackUps zu speichern.

Jetzt benötige ich diese Funktion auch für eine andere Datei, habe den Code übernommen und angepasst...
und jetzt funktioniert nichts mehr.

Erstmal sagt mir Excel bei der Prüfung ob der BackUp-Ordner existiert, das es den Ordner nicht findet und bewirft mich mit einer Fehlermeldung.
Eigentlich sollte in diesem Falle der Ordner erstellt werden.
*grummel*

Wenn ich den Ordner manuell erstelle, wird das Makro ohne Fehlermeldung durchlaufen, aber der Ordner bleibt leer, es wird keine Kopie meiner Datei gespeichert.


Könnt Ihr Euch das bitte mal ansehen und mir eventuell sagen wo ich nen Fehler drinn habe?

Danke Euch

Gruß Achim

Code:

Option Explicit

Dim a As Variant                'fortlaufende Dateinummerierung

Dim Quelle As String            'Quell-Datei
Dim Ziel As String              'BackUp-Datei
Dim Ordner As String            'Pfad/Name des BackUp Ordners

Dim wkb1 As String              'Workbooks("Lagerliste.xlsm")
Dim WBName1 As String           'wkb1 + Datum + a + Dateiendung


Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" _
        (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, _
        ByVal bFailIfExists As Long) As Long
        'bFailIfExists gibt es folgende Möglichkeiten:
        '"0": eine vorhandene Datei soll überschrieben werden
        '"1": eine vorhandene Datei soll nicht überschrieben werden
        'Die Funktion liefert zwei verschiedene Rückgabewerte:
        '"0": Vorgang erfolgreich
        '"1": Vorgang nicht erfolgreich

Public Function API_CopyFile(strSourceFile As String, strTargetFile As String, _
                             Optional lngFileExist As Long = 0) As Long
   API_CopyFile = CopyFile(strSourceFile, strTargetFile, lngFileExist)
End Function

Public Function fctVerzeichnisExists(Ordner As String) As Boolean
On Error GoTo Fehler
    ChDir Ordner
    fctVerzeichnisExists = True
    Exit Function
Fehler:
    fctVerzeichnisExists = False
 End Function

Code:

Public Sub BackupSpeichern()

a = 1
wkb1 = "Lagerliste.xlsm"
WBName1 = "Backup Lagerliste" & " - " & Format(Date, "yyyy-mm-dd") & " - " & a & ".xlsm"
    
    'Ordner erstellen falls nicht existiert
    Ordner = ThisWorkbook.Path & "\Backup Lagerliste"
    If Not fctVerzeichnisExists(Ordner) Then
        MkDir Ordner
    End If
    
    'BackUp Lagerliste
    Quelle = ThisWorkbook.Name
    Ziel = Ordner & "\" & WBName1
        'Abfrage ob Ziel schon existiert und Backup speichern
        If Dir(Ziel) = "" Then
            API_CopyFile Quelle, Ziel
        Else
            For a = 2 To 999
                If Dir(Ziel) = "" Then
                    API_CopyFile Quelle, Ziel
                    Exit For
                End If
            Next a
        End If

End Sub

 

Hallo in die Runde,

schade das niemand etwas zu meinem Problem sagen konnte.

Inzwischen habe ich selber eine Lösung hinbekommen.
(sogar kürzer als vorher)

Hinbekommen deshalb, weil man im WWW zwar zu den meisten Dingen haufenweise Tipps und Lösungen findet, diese aber bei einem selber noch lange nicht funktionieren müssen.
Da muss man erst die korrekte Schreibweise herausfinden, welche Lösung für die benutze Excel-Version geeignet ist, usw... und dann noch an die eigen Anforderungen anpassen und umschreiben.

Naja, falls mal jemand nach so einer Lösung sucht, vielleicht kann er/sie ja dann etwas mit dem hier anfangen:

Code:

Option Explicit

Dim a As Variant                'Variable für Schleife - Dateinamen prüfen ob existiert
                                'fortlaufende Dateinummerierung/Tag

Dim Ziel As String              'Pfad/Name Zieldatei
Dim BackUpOrdner As String      'Pfad/Name des BackUp Ordners

Dim wkb1 As String              'Workbooks("Lagerliste.xlsm")
Dim WBName1 As String           'wkb1 + Datum + a + Dateiendung



Public Sub BackupSpeichern()

a = 1
wkb1 = "Lagerliste.xlsm"
WBName1 = "Backup Lagerliste" & " - " & Format(Date, "yyyy-mm-dd") & " - " & a & ".xlsm"
    
    'Ordner erstellen falls nicht existiert
    BackUpOrdner = ThisWorkbook.Path & "\BackUp Lagerliste"
    If Dir(BackUpOrdner, vbDirectory) = "" Then
        MkDir (BackUpOrdner)
    End If
    
    'BackUp Lagerliste
    Ziel = BackUpOrdner & "\" & WBName1
        'Abfrage ob Ziel schon existiert und Backup speichern
        If Dir(Ziel) = "" Then
            ActiveWorkbook.SaveCopyAs Filename:=BackUpOrdner & "\" & WBName1
        Else
            For a = 2 To 999
                WBName1 = "Backup Lagerliste" & " - " & _
                Format(Date, "yyyy-mm-dd") & " - " & a & ".xlsm"

                Ziel = BackUpOrdner & "\" & WBName1
                If Dir(Ziel) = "" Then
                    ActiveWorkbook.SaveCopyAs Filename:=BackUpOrdner & "\" & WBName1
                    Exit For
                End If
            Next a
        End If

End Sub

Einfach so in ein Modul, ganz ohne Funktion oder so...
klappt bei mir wunderbar.