01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35 |
|
Sub DateienKopieren()
Dim sFile As String, sSuch As String, iAnz As Integer
Dim vGefunden As Variant, FSO As Object
Dim sQuelPath As String, sZielPath As String
sQuelPath = ThisWorkbook.Path & "\PDF-Archiv\"
sZielPath = ThisWorkbook.Path & "\PDF-Archiv\" ' <<<anpassen, ist sonst der gleiche Ordner>>>
CreateDirectory sZielPath ' Zielpfad erstellen (Optional) _
Set FSO = CreateObject("Scripting.FileSystemObject") ' Objektvariable setzen
sFile = Dir$(sQuelPath & "*.pdf") ' Dateisuchmaske auf PDF setzen
Do While sFile <> "" ' Gesamten Order durchsuchen
With ThisWorkbook.Sheets("Fundus") ' Blatt referenzieren
sSuch = Replace(sFile, ".pdf", "", 1, 1) ' Erw. .PDF abtrennen
vGefunden = Application.Match(sSuch, .Range("A:A"), 0)
If IsError(vGefunden) Then
FSO.CopyFile sQuelPath & sFile, sZielPath & sFile ' Datei kopieren
With .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row + 1, 1) ' Daten eintragen
.Value = sSuch
.Offset(0, 1).Value = "Daten aus Ordner " & sQuelPath
iAnz = iAnz + 1 ' Kopierte Dateien zählen
End With
End If
End With
sFile = Dir$ ' Nächste Datei auslesen
Loop
Set FSO = Nothing ' Objekt zerstören
MsgBox iAnz & " Dateien wurden kopiert!", vbInformation, "Dateien kopieren"
End Sub
|