Anzeige
Archiv - Navigation
1596to1600
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

automatisches backup

automatisches backup
30.12.2017 12:03:23
Al
Hallo zusammen,
ich habe eine Exceldatei mit mehreren Blättern als Datenbank erstellt, auf das andere Berechnungsblätter zurgreifen können. Die Datenbank soll kontinuierlich erweitert werden können. Damit man die Übersicht der Erweiterungen behält, habe ich mir überlegt, ein Makro zu schreiben, dass nachdem die Datei gespeichert wurde, ein automatisches Backup in einem von mir vorgesehenen Ordner/Pfad (mit Dateinamen&DatumUhrzeit) erstellt wird.
Da meine Programmierkenntnisse eher schlecht sind, bitte ich um Hilfe.
Mein Code, den ich in "DieseArbeitsmappe" eingefügt habe, sieht wie folgt aus:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean)
Dim sFileName As String
Dim sDateTime As String
Application.DisplayAlerts = False
With ThisWorkbook
sDateTime = " (" & Format(Now, "yyyy-mm-dd hhmm") & ").xlsm"
sFileName = Application.WorksheetFunction.Substitute _
(.FullName, ".xlsm", sDateTime)
.SaveCopyAs sFileName:="C:\Users\Surface 3 Pro\Desktop\"
End With
Application.DisplayAlerts = True
End Sub
Danke für die Hilfe.
Gruß
Al

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: automatisches backup
30.12.2017 12:24:08
Al
Habe schon die Lösung selbst gefunden mit folgendem Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sPfad As String
Dim iClick As Integer
sPfad = "C:\Users\Surface 3 Pro\Desktop\" 'Pfad anpassen
With ActiveWorkbook
.Save
iClick = MsgBox(prompt:="Möchten Sie eine Sicherungskopie anlegen?", Buttons:=vbYesNo)
If iClick = vbYes Then
.SaveCopyAs sPfad & Split(ThisWorkbook.Name, ".xlsm")(0) & "_" & _
Format(Now, "yyyy-mm-dd hhmm") & ".xlsm" 'Dateiendung anpassen
If iClick = vbNo Then
Exit Sub
End If
End If
End With
Application.Quit
End Sub
Trotzdem Danke ;)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige