AW: VBA Datein suchen und kopieren
26.01.2022 22:38:02
Yal
Hmm... was will uns der Künstler damit sagen?
Ich glaube zu verstehen, dass:
es gibt eine Exceldatei eine Liste von "Information", alle in Spalte A. Anhand diese Information wird ein Dateiname zusammengebastelt, vollständig oder zum Teil gehört wohl zum Rätsel. Dann wird diese Datei gesucht und, wenn gefunden, auf einem Zielverzeichnis kopiert. Wenn nicht, dann nichts.
Habe ich so richtig verstanden?
Es könnte so aussehen:
'unter Anbindung von "Microsoft Scriptuing Runtime" (Extras, Verweise..., Haken bei Microsoft Scripting Runtime)
Dim FSO As FileSystemObject
Const cQuellPfad = "D:\Laser"
Const cZielPfad = "C:\Laser\bearbeiten"
Const cEndung = ".dxf"
Sub Liste_durchlaufen()
Dim Z As Range
Set FSO = New FileSystemObject
With Worksheets("Tabelle1")
For Each Z In .Range(.Range("A1"), .Range("A99999").End(xlUp)).Cells
Z.Offset(0, 1) = Verzeichnis_durchlaufen(FSO.GetFolder(cstrInitalPath, Z.Value))
Next
End With
End Sub
Private Function Verzeichnis_durchlaufen(StartFolder As Folder, NamenTeil As String) As Boolean
Dim V As Folder 'V: Verzeichnis
Dim Dateiname As String
'in diesem Verzeichnis alle Datei mit dem Endung durchgehen
Dateiname = Dir(StartFolder.Path & "\*" & NamenTeil & "*" & cEndung, vbNormal)
Do While Dateiname ""
Dateiname = Dir
Loop
'Falls Datei gefunden, kopieren
If Dateiname "" Then
FSO.CopyFile StartFolder.Path & "\" & Dateiname, cZielPfad
Verzeichnis_durchlaufen = True
Exit Function
End If
'alle Unterverzeichnis rekursiv durchgehen
For Each V In StartFolder.SubFolders
If Verzeichnis_durchlaufen(V.Path, NamenTeil) Then Exit Function
Next
End Function
Beachten: 'unter Anbindung von "Microsoft Scriptuing Runtime" (Extras, Verweise..., Haken bei Microsoft Scripting Runtime)
Es Läuft nach dem Prämissen, dass es nur eine Datei gibt, die den gegebenen Muster entspricht. D.h. nach dem finden/kopieren der Datei wird der nächste Eintrag in der Liste A1:Ax bearbeitet.
In Spalte B wird zurückgegeben, ob eine Datei gefunden würde oder nicht.
Nicht getestet, da ich keine Datei zu verschieben habe.
Auf einer Rückmeldung freut man sich immer.
VG
Yal