Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1864to1868
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA Datein suchen und kopieren

VBA Datein suchen und kopieren
26.01.2022 20:36:57
R.
Hallo zusammen,
ich brauche ein VBA Makro das eine Liste abarbeitet beginnend in Spalte A1 dann A2 ende ist nicht bekannt. Die gesuchten Daten haben alle die gleiche Endung (z.B. DXF). Die Dateien sucht in einen Laufwerk incl. Unterordner (z.B. D:/Laser Ordnerunterstrucktur ist dann D:/Laser/2017 usw.) und dann kopiert an einen anderen Platz (z.B. C:/Laser/bearbeiten).
Vielen Dank für eure Hilfe.

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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
Anzeige
AW: VBA Datein suchen und kopieren
27.01.2022 08:18:08
R.
Vielen Danke für die schnelle Antwort.
Ich bekomme einen Fehler in der Liste durchlaufen
Fehler beim Kompilieren
Falsche Anzahl an Argumenenten oder ungültigen Zuweisung zu einer Eigenschaft.
Es wird der Befehl GetFolder markiert.
Vielleicht finden Sie den Fehler.
Vielen Dank schon mal im voraus
AW: VBA Datein suchen und kopieren
27.01.2022 09:11:43
Yal
Hallo R,
ja, jetzt sehe ich mein Versäumnis.
Falsch:

Z.Offset(0, 1) = Verzeichnis_durchlaufen(FSO.GetFolder(cstrInitalPath, Z.Value))
Richtig

Z.Offset(0, 1) = Verzeichnis_durchlaufen(FSO.GetFolder(cstrInitalPath), Z.Value)
Eine wesentliche Unterschied :-)
wie gesagt, da nicht getestet, sicher noch ein paar Macke drin.
VG
Yal
Anzeige
AW: VBA Datein suchen und kopieren
27.01.2022 16:47:48
R.
Leider bekomme ich es nicht hin.
Ich habe eine anderes Skript gefunden dass soweit abarbeitet und auch funktioniert jedoch im Suche Ordner nicht nach Unterordner sucht.

Sub copyFile()
Dim objFSO As Object, rng As Range
Dim strFileToCopy, strOldPath As String, strNewPath As String
strOldPath = "c:\a\" 'Verzeichnis in dem die Datei liegt
strNewPath = "c:\b\" 'Verzeichnis in welches kopiert werden soll
With ActiveSheet
For Each rng In Range("A1:A5")  'Bereich anpassen!
strFileToCopy = rng 'Zelle mit dem Namen
strFileToCopy = strFileToCopy & ".tif" 'Suffix anhängen
If Dir(strOldPath & strFileToCopy, vbNormal)  "" Then
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.copyFile strOldPath & strFileToCopy, strNewPath & strFileToCopy
End If
Next
End With
Set objFSO = Nothing
Set rng = Nothing
End Sub

Anzeige
AW: VBA Datein suchen und kopieren
27.01.2022 20:48:10
Yal
Hallo R,
Das Gesamt setzt voraus, dass Du dich mit dem Coding grundsätzlich auseinander setzst. Von einem Coding aus Internet, den Du nicht verstehst, zu einem anderen Coding, den Du auch nicht verstehst und nicht mal tut, was Du brauchst, aber nur "besser" weil er fehlerfrei läuft, funktioniert nur bis Änderung der Ausgangslage. Dann sucht man wieder im Internet?
Also: ich habe doch ein Verzeichnisstruktur aufgebaut (Extra für Dich), um den Coding zu testen. Ich könnte -freu dich- einige Optimierung vornehmen. Welche kannst Du im Code entdecken.
Jetzt neue Version (die Konstanten müssen angepasst werden!):

Dim FSO As FileSystemObject
Const cQuellPfad = "C:\temp\H_for\" ' \ am Ende ist wichtig
Const cZielPfad = "C:\temp\test\" ' \ am Ende ist wichtig
Const cEndung = ".xls*"
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(cQuellPfad), "*" & Z.Value & "*" & cEndung)
Next
End With
End Sub
Private Function Verzeichnis_durchlaufen(StartFolder As Folder, Muster As String) As Long
Dim V As Folder 'V: Verzeichnis
Dim Dateiname As String
Dim Anzahl As Long
'in diesem Verzeichnis alle Datei mit dem Endung durchgehen
Dateiname = Dir(StartFolder.Path & Muster, vbNormal)
Do While Dateiname  "" 'solang einen Treffer vorliegt, kopieren
FSO.CopyFile StartFolder.Path & Dateiname, cZielPfad
Anzahl = Anzahl + 1
Dateiname = Dir
Loop
'alle Unterverzeichnis rekursiv durchgehen
For Each V In StartFolder.SubFolders
Anzahl = Anzahl + Verzeichnis_durchlaufen(V, Muster)
Next
Verzeichnis_durchlaufen = Anzahl
End Function
Hast Du übrigens die zweimal vorhandene Satz "unter Anbindung von "Microsoft Scripting Runtime" (Extras, Verweise..., Haken bei Microsoft Scripting Runtime)" gelesen und verstanden? Es ist ein nicht ganz unwesentlicher Hinweis.
VG
Yal
Anzeige

331 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige