Automatische Sicherungskopie per VBA

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Pfad = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) & "Archiv\" DATEI = Mid(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\") + 1, Len(ThisWorkbook. _ FullName)) On Error Resume Next SetAttr Pfad & DATEI, 0 'Schreibschutz aus On Error GoTo 0 ThisWorkbook.SaveCopyAs Pfad & DATEI SetAttr Pfad & DATEI, 1 'Schreibschutz ein End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim datei As String Dim fso As FileSystemObject Dim pfad As String Dim wb As Workbook Dim ws As Worksheet Set fso = New FileSystemObject pfad = Me.Path & "\Archiv\" If Not fso.FolderExists(pfad) Then MsgBox "Pfad '" & pfad & "' existiert nicht" Exit Sub End If Set ws = Me.Worksheets("Tabelle2") ' Hier Name deiner Tabelle datei = ws.Range("A1") If datei = "" Then MsgBox "Dateiname fehlt" Exit Sub Else datei = datei & ".xlsm" End If On Error Resume Next Kill pfad & datei On Error GoTo 0 ws.Copy Set wb = ActiveWorkbook wb.SaveAs Filename:=pfad & datei, _ FileFormat:=xlOpenXMLWorkbookMacroEnabled wb.Close End Sub

Hallo Dieter, hallo an alle,
vielen Dank für den Lösungsansatz.
Diesen kann ich bei mir auf der Arbeit leider nicht verwenden.
Hinweis von Dieter war:
Das Programm braucht einen Verweis auf die Bibliothek ""Microsoft Scripting Runtime"" VBA-Editor: Extras - Verweise...
Hierzu habe ich aber aufgrund eingeschränkter Benutzer- Berechtigung in meiner Firma keinen Zugriff.
Gibt es trotzdem eine Lösung für mein Ziel:
Ich möchte nur ein einziges Tabellenblatt aus einer Datei heraus kopieren und mit dem Wert aus Zelle A1 als Dateiname (&".xlsm") im Unterordner "Archiv" des ursprünglichen Speicherortes abspeichern.
Die in diesem Tabellenblatt gespeicherten VBA- Codes sollen ebenfalls dabei erhalten bleiben.
Kennt jemand den Code für dieses Vorhaben?
Vielen Dank im voraus.
Ansonsten wünsche ich allen ein frohes Weihnachtsfest und einen guten Start ins Jahr 2015
Harald G.
P.S. Wir arbeiten mit Office 2013
Mein Level: Excel gut - VBA bescheiden

Hallo Harald,
die Bibliothek "Microsoft Scripting Runtime" ist für dein Problem ganz irrelevant.
Ich habe sie nur verwendet, um die Existenz des Verzeichnisses "...\Archiv\" zu prüfen.
Du kannst aber genauso gut auch die gute alte Dir-Funktion verwenden.
Das Programm lautet dann:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim datei As String
Dim pfad As String
Dim wb As Workbook
Dim ws As Worksheet
pfad = Me.Path & "\Archiv\"
If Dir(pfad, vbDirectory) = "" Then
MsgBox "Pfad '" & pfad & "' existiert nicht"
Exit Sub
End If
Set ws = Me.Worksheets("Tabelle2") ' Hier Name deiner Tabelle
datei = ws.Range("A1")
If datei = "" Then
MsgBox "Dateiname fehlt"
Exit Sub
Else
datei = datei & ".xlsm"
End If
On Error Resume Next
Kill pfad & datei
On Error GoTo 0
ws.Copy
Set wb = ActiveWorkbook
wb.SaveAs Filename:=pfad & datei, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
wb.Close
End Sub

Viele Grüße und schöne Weihnachtstage
Dieter

Beliebteste Forumthreads (12 Monate)

Automatische Sicherungskopie per VBA

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

1 Forumthread zu ähnlichem Thema

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Automatische Sicherungskopie per VBA

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

1 Forumthread zu ähnlichem Thema

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread