AW: Automatisches Speichern in spez. Ordnern
11.12.2022 16:32:13
Nepumuk
Hallo Frank,
teste mal:
Option Explicit
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Public Sub Speichern()
Const FOLDER_PATH As String = "H:\221211\" ' Ordner anpassen !!!
Dim strFolder As String, strFilename As String
Dim lngReturn As Long
strFolder = FOLDER_PATH & Format$(Date, "mm_yyyy") & "\"
lngReturn = MakeSureDirectoryPathExists(strFolder)
If lngReturn = 1 Then
strFilename = strFolder & Format$(Date, "yyyy_mm_dd") & " " & ThisWorkbook.Name
If Dir$(strFilename) vbNullString Then
If MsgBox("Die Datei existiert bereits." & vbLf & vbLf & "Überschreiben", _
vbQuestion Or vbYesNo, "Sicherheitsabfrage") = vbYes Then
Application.DisplayAlerts = False
Call ThisWorkbook.SaveCopyAs(Filename:=strFilename)
Application.DisplayAlerts = True
End If
Else
Call ThisWorkbook.SaveCopyAs(Filename:=strFilename)
End If
Else
Call MsgBox("Fehler beim Erstellen des Ordners.", vbCritical, "Dateisystemfehler")
End If
End Sub
Gruß
Nepumuk