Datei automatisch im Monatsordner speichern

[hddiesel]

Hallo Turbo123,

zu deiner Nachfrage:

Aber ändere ich dein Code um das er nicht eine xlsx sondern eine xlsm Datei speichert??

Infos dazu im Makro CODE

Sicher könnte man deinen Code noch einfacher schreiben, wenn man dein Vorhaben genauer kennen würde.
z.B. Dateipfad ist immer gleich, außer dem Monatsnamen und eventuell SheetNamen

Die Unbekannte ist Range("B3").Value, eventuell der SheetName

z.B. welche Daten sollen im Dateinamen gespeichert werden, u.s.w.
"F:\Uwe\Documents\Excel\Test\November\Sicherung\OriginalDatName_Postausgang_01_Nov_2019_112217.xlsx"
"F:\Uwe\Documents\Excel\Test\November\Sicherung\OriginalDatName_Posteingang_01_Nov_2019_112213.xlsx"

Den Dateipfad und Dateiname kannst du selbst nach wunsch anpassen.

Code:

Option Explicit

'
'Deklarieren für 64-Bit, oder 32-Bit Excelversion
'
#If VBA7 Then
   Declare PtrSafe Function MakePath& Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal sPath$)
 
#Else
   Declare Function MakePath& Lib "imagehlp.dll" Alias "MakeSureDirectoryPathExists" (ByVal sPath$)
 
#End If


Sub SpeichernUnterHG()
   Dim Pfad    As String
   Dim datName As String

   Pfad = "F:\Uwe\Documents\Excel\Test\" & Format(Date, "MMMM") & "\Sicherung\"
   datName = Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "_" _
       & ActiveSheet.Name & "_" & Format(Now, "DD_MMM_YYYY_hhmmss")

   'DateiPfad erstellen, wenn nicht vorhanden
   MakePath Pfad

   ActiveSheet.Copy
   
   'Info zu FileFormat:=
   '50 = .xlsb
   '51 = .xlsx
   '52 = .xlsm
   '53 = .xltm
   '54 = .xltx
   '55 = .xlam
   '56 = .xls
   '57 = .pdf
   '58 = .xps

'    ActiveWorkbook.SaveAs Filename:=Pfad & "\Test_" & Range("B3").Value & "_" & Format(Now, "DD_MMM_YYYY_hhmm"), FileFormat:=52
   ActiveWorkbook.SaveAs Filename:=Pfad & datName, FileFormat:=51
   ActiveWorkbook.Close

End Sub

[snb]

@hhd

Ohne API:

Code:

    CreateObject("shell.application").Namespace("G:").NewFolder "OF\AA1\BB2"