Super aber
09.04.2015 09:57:41
Thomas
erstmal vielen Dank für die schnelle Hilfe.
habe erstmal das Leerzeichen gesetzt und dann PtrSafe gelöscht. Es sieht jetzt so aus
wie unten. Es wurde auch eine Sicherung erstellt. Bekommt man das auch so hin das nur eine Sicherung am Tag durchgeführt wird?
Würde auch gern die Codergänzung von Rudi probieren weiss nur nicht wohin damit.
Liebe Grüsse Thomas
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Private Sub Workbook_Open()
Const COPY_FOLDER As String = "\Sicherung\"
Const STORE_DAYS As Long = 56
Dim lngReturn As Long
Dim strPath As String, strFilename As String
Dim strWorkbookName As String, strExtension As String
strPath = Path & COPY_FOLDER
lngReturn = MakeSureDirectoryPathExists(strPath)
If lngReturn = 1 Then
strWorkbookName = Left$(Name, InStrRev(Name, ".") - 1)
strExtension = Right$(Name, Len(Name) - InStrRev(Name, ".") + 1)
strFilename = strWorkbookName & "_" & Format(Now, "yyyy_mm_dd_hh_nn_ss") & strExtension
Call SaveCopyAs(strPath & strFilename)
strFilename = Dir$(strPath & strWorkbookName & "*" & strExtension)
Do Until strFilename = vbNullString
If Now - FileDateTime(strPath & strFilename) > STORE_DAYS Then _
Call Kill(strPath & strFilename)
strFilename = Dir$
Loop
Else
Call MsgBox("Ordner für Sicherungskopie konnte nich angelegt werden." & _
vbLf & vbLf & "Bitte unbedingt Herrn Kaffl Tel. 1625 verständigen.", vbCritical, "Fehler")
End If
End Sub