AW: Ordner dynamisch erstellen
28.07.2021 11:44:47
Tim
Vielen Dank Nepumuk es klappt :)
Da ich jetzt nicht nur eine Datei auswähle und abspeichere sondern 4, ist die Frage ob du noch Tipps für mich hast. Da der Code sehr lange ist und die Excel Mappen offen bleiben.
Option Explicit
Private Declare PtrSafe Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
ByVal DirPath As String) As Long
Public Sub Ordner_erstellen_files_abspeicher_umbennen()
Dim strPath As String
Dim strFile As String
Dim objWorkbook As Workbook
' Öffne das Downloadverzeichnis und wähle File aus, welches in den Ordner verschoben werden soll.
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Bitte Report auswählen"
.InitialFileName = "C:\Users\101\Downloads\"
.FilterIndex = 2
If .Show Then strFile = .SelectedItems(1)
End With
If strFile vbNullString Then
strPath = "C:\Users\101\Test " & Format$(Date, "dd_mm_yy") & "\"
Call MakeSureDirectoryPathExists(strPath)
Set objWorkbook = Workbooks.Open(Filename:=strFile)
Call objWorkbook.SaveAs(Filename:=strPath & "01Process", FileFormat:=xlOpenXMLWorkbook)
Set objWorkbook = Nothing
End If
' Öffne das Downloadverzeichnis und wähle File aus, welches in den Ordner verschoben werden soll.
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Bitte Report auswählen"
.InitialFileName = "C:\Users\101\Downloads\"
.FilterIndex = 2
If .Show Then strFile = .SelectedItems(1)
End With
If strFile vbNullString Then
strPath = "C:\Users\101\Test " & Format$(Date, "dd_mm_yy") & "\"
Call MakeSureDirectoryPathExists(strPath)
Set objWorkbook = Workbooks.Open(Filename:=strFile)
Call objWorkbook.SaveAs(Filename:=strPath & "02Process", FileFormat:=xlOpenXMLWorkbook)
Set objWorkbook = Nothing
End If
' Öffne das Downloadverzeichnis und wähle File aus, welches in den Ordner verschoben werden soll.
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Bitte Report auswählen"
.InitialFileName = "C:\Users\101\Downloads\"
.FilterIndex = 2
If .Show Then strFile = .SelectedItems(1)
End With
If strFile vbNullString Then
strPath = "C:\Users\101\NoC " & Format$(Date, "dd_mm_yy") & "\"
Call MakeSureDirectoryPathExists(strPath)
Set objWorkbook = Workbooks.Open(Filename:=strFile)
Call objWorkbook.SaveAs(Filename:=strPath & "03Document", FileFormat:=xlOpenXMLWorkbook)
Set objWorkbook = Nothing
End If
' Öffne das Downloadverzeichnis und wähle File aus, welches in den Ordner verschoben werden soll.
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Title = "Bitte Report auswählen"
.InitialFileName = "C:\Users\101\Downloads\"
.FilterIndex = 2
If .Show Then strFile = .SelectedItems(1)
End With
If strFile vbNullString Then
strPath = "C:\Users\101\NoC " & Format$(Date, "dd_mm_yy") & "\"
Call MakeSureDirectoryPathExists(strPath)
Set objWorkbook = Workbooks.Open(Filename:=strFile)
Call objWorkbook.SaveAs(Filename:=strPath & "04Document", FileFormat:=xlOpenXMLWorkbook)
Set objWorkbook = Nothing
End If
End Sub
