AW: mehrere Dateien finden mit selben Anfang
17.04.2020 10:20:50
fcs
Hallo Ronald,
man muss dann die Dateinamen mit der DIR-Methode im Ordner suchen und in einem Daten-Array sammeln.
LG
Franz
Sub Dateiliste_erstellen_kopieren()
Dim varFile() As String, intF As Integer
Dim wksListe As Worksheet, zei As Integer
Dim sFileName As String
Dim varOrdner As Variant, varZielOrdner As Variant
Set wksListe = ActiveSheet 'ggf. ActiveWorkbook.Worksheets("Tabelle XYZ")
'Ordner mit pdf-Dateien auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner/Verzeichnis mit den PDF-Dateien auswählen"
If .Show = -1 Then
varOrdner = .SelectedItems(1)
Else
Exit Sub
End If
End With
With wksListe
'Dateinamen in Spalte A ab Zeile 2 abarbeiten
For zei = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
sFileName = Dir(varOrdner & "\" _
& Replace(.Cells(zei, 1).Text, ".pdf", "*.pdf"), vbNormal)
Do Until sFileName = ""
intF = intF + 1
ReDim Preserve varFile(1 To intF)
varFile(intF) = sFileName
sFileName = Dir
Loop
Next
End With
If intF = 0 Then
MsgBox "Keine Dateien im Ordner """ & varOrdner & """ gefunden!"
Else
'Zielordner auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ziel-Ordner/Verzeichnis für die PDF-Dateien auswählen"
If .Show = -1 Then
varZielOrdner = .SelectedItems(1)
Else
Exit Sub
End If
End With
'Dateien in Zielordner kopieren
For intF = 1 To UBound(varFile)
VBA.FileCopy varOrdner & "\" & varFile(intF), varZielOrdner & "\" & varFile(intF)
Next
End If
End Sub