Thorsten, dank für den Tipp
03.12.2023 14:16:50
walter b
Hallo Thorsten,
danke für den Tipp.
Leider klappt es nicht damit.
Dim dlgAuswahl As FileDialog
Set dlgAuswahl = Application.FileDialog(msoFileDialogFilePicker)
' Set dlgAuswahl = Application.FileDialog(msoFileDialogFolderPicker) '3.12.23 klappt nicht
das Makro läuft durch und hiermit:
With dlgAuswahl
.Filters.Clear
.Filters.Add "Excel Dateien", "*.pdf"
.InitialFileName = Verzeichnis
.Show
End With
werden alle vorhandenen PDF Exceldateien im Explorer angezeigt.
In dem vorhandenen Verzeichnis ist ein Ordner "PDF" vorhanden.
Jetzt habe ich die PDF Dateien ausgewählt und in dem Ordner PDF geschoben.
Also ich würde es so lassen.
Hier mal das kompl. Makro:
Public Sub PDF_Rechnung_suchen()
DoEvents
Dim dlgAuswahl As FileDialog
Set dlgAuswahl = Application.FileDialog(msoFileDialogFilePicker)
' Set dlgAuswahl = Application.FileDialog(msoFileDialogFolderPicker) '3.12.23 klappt leider nicht
Dim AppWD As Object
Dim strDatei, lstrExt() As String
Dim Verzeichnis
If ActiveSheet.Range("N1") = "Firma" Then
Verzeichnis = "\\Buchhaltung\D\__Dokumente\__Rechnungen\" _
& ActiveSheet.Range("Q1") & "\" & Format(Range("R1"), "00 ") & MonthName(Range("R1"))
If Dir(Verzeichnis, vbDirectory) = "" Then
MsgBox "Das Jahr oder der Monat ist noch nicht im Verzeichnis vorhanden !" _
& Chr(10) & "um Rechnung zu suchen muß erst eine Rechnung aktuell gespeichert sein !" _
& Chr(10) & "" _
& Chr(10) & "Es wird das vorhandene Verzeichnis geöffnet ! "
ChDrive "D:\"
' Verzeichnis = "D:\__Dokumente\__Rechnungen\"
Verzeichnis = "\\Buchhaltung\D\__Dokumente\__Rechnungen\"
Else
With dlgAuswahl
.Filters.Clear
.Filters.Add "Excel Dateien", "*.pdf"
.InitialFileName = Verzeichnis
.Show
End With
End If
mfg walter b