Forumbeitrag
Excel-Version des Fragestellers:
2019
Erfahrungslevel des Fragestellers:
Kaum Excel/VBA-Kenntnisse
In ein Modul.
Option Explicit
Sub PDF_Dateinamen_Einlesen()
Dim Ordner As String
Dim Datei As String
Dim ws As Worksheet
Dim Zeile As Long
Dim Teile() As String
'Tabelle festlegen
Set ws = ActiveSheet
'Überschriften
ws.Cells.Clear
ws.Range("A1") = "Kundennummer"
ws.Range("B1") = "Quittungsnummer"
ws.Range("C1") = "Anrede"
ws.Range("D1") = "Vor- und Nachname"
ws.Range("E1") = "Straße + HsNr"
ws.Range("F1") = "PLZ + Ort"
ws.Range("G1") = "Steuernummer"
Zeile = 2
'Ordner wählen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "PDF Ordner wählen"
If .Show = -1 Then
Ordner = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
Application.ScreenUpdating = False
Datei = Dir(Ordner & "*.pdf")
Do While Datei <> ""
'pdf entfernen
Datei = Left(Datei, Len(Datei) - 4)
'am Bindestrich trennen
Teile = Split(Datei, "-")
If UBound(Teile) >= 5 Then
ws.Cells(Zeile, 1) = Trim(Teile(0))
ws.Cells(Zeile, 2) = Trim(Teile(1))
ws.Cells(Zeile, 3) = Trim(Teile(2))
ws.Cells(Zeile, 4) = Trim(Teile(3))
ws.Cells(Zeile, 5) = Trim(Teile(4))
ws.Cells(Zeile, 6) = Trim(Teile(5))
If UBound(Teile) >= 6 Then
ws.Cells(Zeile, 7) = Trim(Teile(6))
End If
Zeile = Zeile + 1
End If
Datei = Dir
Loop
ws.Columns.AutoFit
Application.ScreenUpdating = True
MsgBox "Fertig. " & Zeile - 2 & " PDFs eingelesen."
End Sub
sollte gehen