Ich habe in einem Ordner (C:\Vteile) ca. 10.000 PDF-Dateien.
Nun bekomme ich eine Liste mit ca. 300 Einträgen ( Nummern die den ersten 8 Zahlen der Dateinamen entsprechen z.B. 40402289) Nun möchte ich die Liste per Makro durchgehen und wenn die Nummer aus der Liste den ersten 8 Zahlen des Dateinamens entspricht soll diese Kopiert werden.
bisher habe ich das wie folgt:
(braucht extrem lange.
Option Explicit
Sub copy()
Dim fs As Object
Dim fVerz As Object
Dim fso As Object
Dim Datei As Object
Dim Dateien As Object
Dim strPfad1 As String, strPfad2 As String
Dim lngRow As Long
Dim DNM As String
Dim DNMCHK As String
Dim Weiterbed As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set fs = CreateObject("scripting.FileSystemObject")
Set fVerz = fs.Getfolder(Range("F4").Text)
Set Dateien = fVerz.Files
strPfad1 = Range("F4").Text
strPfad2 = Range("F9").Text
For Each Datei In Dateien
For lngRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
Cells(lngRow, 1).Activate
Weiterbed = Left(Cells(lngRow, 1).Text, 2)
If Not Weiterbed = "30" Then
DNM = Left(Datei.Name, 8)
DNMCHK = Cells(lngRow, 1).Text
If DNMCHK = DNM Then
fso.CopyFile strPfad1 & Datei.Name, strPfad2, True
Exit For
End If
Next
End If
Next
End Sub
Hat mir einer einen Vorschlag wie das Schneller Geht?P.S.
Entschuldigt die Chaotische Struktur.......