Code zur Datensicherung

Hallo zusammen,
es ist zum verzweifeln, ich komme leider nicht mehr weiter.
Über einen CommandButton möchte ich von einer zweiten, geöffneten Excel Datei eine Datensicherung erstellen.
Im ersten Zuge prüft das Makro, ob der Ordner für die Datensicherung besteht, wenn nicht wird er erstellt.
Anschließen das Workbook aktiviert und (wenn es denn klappt) im erstellten Ordner gespeichert.
https://www.herber.de/bbs/user/107067.xlsm
Soweit so gut, allerdings läuft er mir an zwei Stellen ins aus:
1) möchte ich beim Speichern den soeben erstellten Ordner auswählen --> Syntaxfehler
2) wenn ich die Datei dann nur im Ordner "Datensicherung" ohne Datumsangabe speichern will bekomme ich die Meldung:

Laufzeitfehler 1004
Die Methode "SaveAs" für das Objekt '_Workbook' ist fehlgeschlagen.

Der Debugger markiert mir dann die zweite Zeile des Codes ab "FileFormat"
Im Moment bin ich überfragt, woran es hängt.
Ich hoffe, hier im Forum kann mir jemand weiterhelfen?
Ich freue mich eure Rückmeldungen.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Datensicherung() ' Datensicherung Makro 'Prüfen ob Ordner für Datensicherung bereits besteht. 'Wenn nicht, Ordner erstellen. If Dir("D:\Datensicherung\" & Format(Now, "yy-mm-dd"), vbDirectory) = "" Then MkDir ("D:\Datensicherung\" & Format(Now, "yy-mm-dd")) End If 'zu sichernde Datei Windows("Mappe2.xlsm").Activate 'Datensicherung speichern und benennen ActiveWorkbook.SaveAs Filename:="D:\Datensicherung\" & Format(Now, "yy-mm-dd") & "\" & " _ Auto_Datensicherung.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'Datensicherung speichern ActiveWorkbook.Close End Sub

Sub Datensicherung() ' Datensicherung Makro Dim Ordner As String Dim DateiName As String Dim NameWb2 As String Ordner = Format(Now, "yy-mm-dd") DateiName = "Auto_Datensicherung.xlsm" NameWb2 = "Mappe2.xlsm" 'Prüfen ob Ordner für Datensicherung bereits besteht. 'Wenn nicht, Ordner erstellen. If Dir("D:\Datensicherung\" & Ordner, vbDirectory) = "" Then MkDir ("D:\Datensicherung\" & Ordner) End If 'Datensicherung speichern und benennen Workbooks(NameWb2).SaveAs Filename:="D:\Datensicherung\" & Ordner & "\" & DateiName, _ FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False 'Datensicherung speichern Workbooks(DateiName).Close End Sub

Ach ja du solltest auch noch was rein machen um den Fehler abzufangen wenn du zB. die Mappe2 nicht geöffnet hast (prüfen ob datei geöffnet)mit der Funktion IsFileOpen

Sub Datensicherung()
' Datensicherung Makro
Dim Ordner As String
Dim DateiName As String
Dim NameWb2 As String
Ordner = Format(Now, "yy-mm-dd")
DateiName = "Auto_Datensicherung.xlsm"
NameWb2 = "Mappe2.xlsm"
'Prüfen on Mappe2 geöffnet ist
If IsFileOpen(NameWb2) Then
'Prüfen ob Ordner für Datensicherung bereits besteht.
'Wenn nicht, Ordner erstellen.
If Dir("D:\Datensicherung\" & Ordner, vbDirectory) = "" Then
MkDir ("D:\Datensicherung\" & Ordner)
End If
'Datensicherung speichern und benennen
Application.DisplayAlerts = False
Workbooks(NameWb2).SaveAs filename:="D:\Datensicherung\" & Ordner & "\" & DateiName,  _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
'Datensicherung speichern
Workbooks(DateiName).Close
Else
MsgBox "Die Datei " & NameWb2 & " ist nicht geöffnet"
End If
End Sub

Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next   ' Turn error checking off.
filenum = FreeFile()   ' Get a free file number.
Open filename For Input Lock Read As #filenum
Close filenum          ' Close the file.
errnum = Err           ' Save the error number that occurred.
On Error GoTo 0        ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Code zur Datensicherung

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread