PDF Dateien in Verzeichnisse kopieren

Hallo zusammen,
ich möchte per VBA PDF-Dateien (Zeichnungen) aus bestimmten Verzeichnissen in andere vorgegebene Verzeichnisse kopieren. Dabei müssen bestimmte Logiken eingehalten werden. Leider habe ich quasi keinerlei Erfahrung und bräuchte hierbei Unterstützung.
Zur Ausgangslage:
Ich habe ein Projektverzeichnis, das verschiedene Projekte beinhaltet. Jedes Projekt hat einen eigenen Ordner. Hier die relevanten Windows Pfade beispielhaft.
Projekte\Projekt A\Technische_Unterlagen\Zeichnungen\Fertige Zeichnungen\
Projekte\Projekt B\Technische_Unterlagen\Zeichnungen\Fertige Zeichnungen\
Projekte\Projekt C\Technische_Unterlagen\Zeichnungen\Fertige Zeichnungen\
Im Ordner Fertige Zeichnungen wiederum befinden sich verschiedene Unterordner. Aus all diesen Unterordnern müssen grundsätzlich die PDF Dateien kopiert werden. Nun stehen in meiner Exceldatei verschiedene Infos, die quasi steuern
a. welche Dateien überhaupt kopiert werden sollen
b. wohin diese Dateien kopiert werden sollen
Mal angenommen wir haben Projekt A. Für dieses Projekt stehen die Angaben zu den Zielordnern in den Spalten E und F (ab Zeile 3). In Spalte A steht eine Zeichnungsnummer, die sich auch im Dateinamen der Zeichnungen wiederfindet.
Hier ein Beispiel:
In Zeile 3 steht in Spalte E PMA und in Spalte F Rockson. In Spalte A steht 1954_01.00 als Zeichnungsnummer. Nun müsste das Makro in das Verzeichnis
Projekte\Projekt A\Technische_Unterlagen\Zeichnungen\Fertige Zeichnungen\
schauen und dort alle Unterordner einmal durchlaufen. Findet es eine PDF-Datei, die den String 1954_01.00 enthält (z.B. 13757_1954_01.00_REV.00 Active Hull Protective System.pdf), so soll diese in das Verzeichnis PMA und in das Verzeichnis Rockson kopiert werden. Beide Verzeichnisse liegen unter C:\temp, sprich C:\temp\PMA und C:\temp\Rockson.
Steht in Spalte E bzw. F nichts, so soll auch nichts mit der Datei passieren für dieses Projekt. Alle weiteren Zeilen müssten jetzt nach dem selben Prinzip als Schleife durchlaufen werden (bis zur letzten Datenzeile).
Dasselbe muss dann auch für die anderen Projekte passieren. Hier die relevanten Spalten mit den Zielen für alle Projekte:
Projekt A: E und F
Projekt B: H und I
Projekt C: K und L
Projekt D: N und O
Projekt E: Q und R
Projekt F: T und U
Folgende Zielverzeichnisse existieren:
C:\temp\PMA
C:\temp\Besecke
C:\temp\WSAM
C:\temp\Rockson
Steht also in den Zielspalten der Projekte PMA, Besecke, WSAM oder Rockson, so sollen die Dateien in die entsprechenden Verzeichnisse kopiert werden.
Ich hoffe es ist klar, was ich erreichen möchte.
Hier befindet sich eine Musterdatei, damit man sich den Aufbau besser vorstellen kann: https://www.herber.de/bbs/user/151034.xlsx
Für Hilfe wäre ich sehr dankbar
Patrick

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Patrick,
mit ein bischen Fleiss hättest Du es auch hinbekommen...
Beachten: 'Unter Verweis auf "Microsoft Scripting Runtime"


'Unter Verweis auf "Microsoft Scripting Runtime"
Dim FSO As FileSystemObject
Public Sub Start()
Const cP1 = "Projekte\Projekt "
Const cP2 = "\Technische_Unterlagen\Zeichnungen\Fertige Zeichnungen\"
Set FSO = New FileSystemObject
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "A" & cP2), "1954_01.00", "Rockson"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "A" & cP2), "3010_01.01", "Rockson"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "A" & cP2), "3310_01.00", "Rockson;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "A" & cP2), "3313_10.01", "Rockson"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "B" & cP2), "1954_01.00", "besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "B" & cP2), "3010_01.01", "besecke"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "B" & cP2), "3310_01.00", "besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "B" & cP2), "3313_10.01", "besecke"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "C" & cP2), "1954_01.00", "Besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "C" & cP2), "3010_01.01", "Besecke"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "C" & cP2), "3310_01.00", "Besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "C" & cP2), "3313_10.01", "Besecke"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "D" & cP2), "1954_01.00", "WSAM;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "D" & cP2), "3010_01.01", "WSAM"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "D" & cP2), "3310_01.00", "WSAM;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "D" & cP2), "3313_10.01", "WSAM"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "E" & cP2), "1954_01.00", "Besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "E" & cP2), "3010_01.01", "Besecke"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "E" & cP2), "3310_01.00", "Besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "E" & cP2), "3313_10.01", "Besecke"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "F" & cP2), "1954_01.00", "Besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "F" & cP2), "3010_01.01", "Besecke"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "F" & cP2), "3310_01.00", "Besecke;PMA"
Verzeichnis_durchgehen FSO.GetFolder(cP1 & "F" & cP2), "3313_10.01", "Besecke"
End Sub
Private Sub Verzeichnis_durchgehen(Basisverz As Folder, Filter As String, Ziele As String)
Dim F As File
Dim V
'Dateien im Folder durchgehen
For Each F In Basisverz.Files
If InStr(1, F.Name, Filter, vbTextCompare) Then
For Each V In Split(Ziele, ";")
F.Copy FSO.GetFolder("C:\temp\" & V).Path
Next
End If
Next
'Unterverzeichnis durchgehen
For Each V In Basisverz.SubFolders
Verzeichnis_auflisten V, Filter, Ziele
Next
End Sub

Ungetestet. Verwendung auf eigene Gefahr. Ich würde nur die erste Zeile zuerst testen.
VG
Yal

'Unter Verweis auf "Microsoft Scripting Runtime" Dim FSO As FileSystemObject Const cP1 = "Projekte\" Const cP2 = "\Technische_Unterlagen\Zeichnungen\Fertige Zeichnungen\" Const cZiel = "C:\Temp\" Sub Auflisten() Dim Z As Range Dim R Dim Ziele As String Set FSO = New FileSystemObject With Worksheets("Tabelle1") For Each Z In .Range(.Range("A4"), .Range("A99999").End(xlUp)).Cells For Each R In Array("E", "H", "K", "N", "Q", "T") Ziele = "" With .Cells(Z.Row, R) If .Value "---" And .Value "" Then Ziele = ";" & cZiel & .Value & "\" If .Offset(0, 1).Value "---" And .Offset(0, 1).Value "" Then Ziele = Ziele & ";" & cZiel & .Offset(0, 1).Value & "\" End With Ziele = Mid(Ziele, 2) 'vordere ";" weg 'Version Test Debug.Print cP1 & .Cells(1, R) & cP2, Z.Value, Ziele 'Version ernst ' If Ziele "" Then Verzeichnis_durchgehen cP1 & .Cells(1, R) & cP2, Z.Value, Ziele Next Next End With End Sub Private Sub Verzeichnis_durchgehen(Basisverz As String, Filter As String, Ziele As String) Dim F As File Dim V 'Dateien im Folder durchgehen For Each F In FSO.GetFolder(Basisverz).Files If InStr(1, F.Name, Filter, vbTextCompare) Then For Each V In Split(Ziele, ";") F.Copy FSO.GetFolder(V).Path Next End If Next 'Unterverzeichnis durchgehen For Each V In FSO.GetFolder(Basisverz).SubFolders Verzeichnis_auflisten V.Path, Filter, Ziele Next End Sub

'Unter Verweis auf "Microsoft Scripting Runtime" Dim FSO As FileSystemObject Const cP1 = "C:\temp\Projekte\" Const cP2 = "\Technische_Unterlagen\Zeichnungen\Fertige Zeichnungen\" Const cZiel = "C:\temp\" Sub Auflisten() Dim Z As Range Dim R Dim Ziele As String Set FSO = New FileSystemObject With Worksheets("Tabelle1") For Each Z In .Range(.Range("A4"), .Range("A99999").End(xlUp)).Cells For Each R In Array("E", "H", "K", "N", "Q", "T") Ziele = "" With .Cells(Z.Row, R) If .Value "---" And .Value "" Then Ziele = ";" & cZiel & .Value & "\" If .Offset(0, 1).Value "---" And .Offset(0, 1).Value "" Then Ziele = Ziele & ";" & cZiel & .Offset(0, 1).Value & "\" End With Ziele = Mid(Ziele, 2) 'vorderes ";" entfernen If Ziele "" Then Verzeichnis_durchgehen cP1 & .Cells(1, R) & cP2, Z.Value, Ziele Next Next End With End Sub Private Sub Verzeichnis_durchgehen(Basisverzeichnis As String, Filter As String, Ziele As String) Dim F As File Dim V 'Dateien im Folder durchgehen For Each F In FSO.GetFolder(Basisverzeichnis).Files If InStr(1, F.Name, Filter, vbTextCompare) Then For Each V In Split(Ziele, ";") F.Copy FSO.GetFolder(V).Path Next End If Next 'Unterverzeichnis durchgehen For Each V In FSO.GetFolder(Basisverzeichnis).SubFolders Verzeichnis_durchgehen V.Path, Filter, Ziele Next End Sub

Beliebteste Forumthreads (12 Monate)

PDF Dateien in Verzeichnisse kopieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

262 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

PDF Dateien in Verzeichnisse kopieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

262 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread