Office: Verzeichnisse aufräumen, VBA

Hallo zusammen,

ich suche eine Möglichkeit teilautomatisiert Verzeichnisse umzusortieren.

Ich habe eine Datenstruktur vorliegen die wie folgt aussieht:
in den Unterverzeichen Typ \pdf liegen
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_1_130701.pdf
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_1_140501.pdf
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_1_140601.pdf
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_1_140729.pdf
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_2_130701.pdf
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_2_140501.pdf
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_2_140601.pdf
P:\Projekt_123\Tender_123\Inhalt_123\pdf\Dateiname_2_140729.pdf

Die Namen wie Dateiname_1, Dateiname_2, Dateiname_3 usw. wiederholen sich also und unterscheiden sich als nur in den letzen 4 Stellen. Im Grunde in das nicht anders als eine Dateihistorie mit der Kennzeichnung der letzen Version. Ich möchte nun von jedem Dateinamen nur noch jeweils die letzte Version im Verzeichnis \PDF haben. Die anderen sollen in ein Unterverzeichnis Archiv abgelegt werden.

Ich habe mir nun gedacht wenn das komplette Verzeichnis in eine Excelsheet gezogen würde, könnte ich die Analyse des Dateinamens vornehmen und die zu verschiebenden Dateien in eine getrennte Spalte schreiben und diese dann mittels VBA Schleife und Cut/Paste in das andere Verzeichnis scheiben. Pro Verzeichnis sind das etwa 40 Dateinamen mit ca. 3-5 versione. Final wären dann alle Pfade und Dateien des Projektes in eine Excelliste einzulesen.

Bekäme man (frau) das hin?

Das gleiche wiederholt sich mit den extensionen DWG und DWF
P:\Projekt_123\Tender_123\Inhalt_123\dwg\Dateiname_130701.dwg
P:\Projekt_123\Tender_123\Inhalt_123\\dwf\Dateiname_130701.dwf
auch diese Extensionen sollte archiviert werden.

Vielen dank schon mal für Eure Hilfe

Gruß
Bernd

Office / Excel 2010 UK Version noch Win XP gerade in Migration auf Win 7

 

Hallo Ratzmer,

vielleicht wäre mein Add-In zum Auflisten eines Verzeichnisses, welches Du beim Excel-Ticker.de findest, hilfreich. Das Add-In ist zwar etwas älter und noch für Excel 2003, läuft i.d.R. aber auch unter höheren Versionen, solange Du kein 64-Bit verwendest. Das Add-In erstellt Dir dann eine Ausgabemappe mit den Dateien, die Du dann für Dein Vorhaben verwenden könntest. Kennwort zum Code findest Du im Artikel.

Gruß

 

Hallo maninweb,


Danke schon mal für die schnlle Antwort. Leider kann ich keine fremden Add-ins verwenden (higtsecurity). Bin schon froh das ich mir den Developer Bereich aufmachen durfte. Ich schau mir das Add-in mal an. Ich habe allerdings dort Office 365 und noch keine Erfahrung auf der Version mit Add-ins. Ich würde das Probklem lieber mit einer einfachen Makro/VBA Routine lösen.

Bernd

 

Hallo Bernd,

ok, nachvollziehbar. Hier im Forum gibt's auch einen Thread, wo die Dateien per FileSystem-Object ausgelesen werden: Dateinamen aus Verzeichnis auslesen und in Tabelle schreiben. Wenn's nicht Abertausende von Dateien sind, würde das auch ausreichend sein, denke ich mal.

Gruß

 

Hi Mainweb,

das Auslesemakro von Hajo_zi macht das auslesen hervorragend, ich denke das kann ich so verwenden. Danke für den Tipp. Das herausfinden der Dateien aus der Liste ist jetzt die nächste Stufe. Ich muß jetzt herausfinden ob die Datei einen Vorgänger hat, wenn nein ok, wenn ja Vorgänger in neues Verzeichnis schieben

Ich würde jetzt den neuen Pfad mit den Dateien welche zu verschieben sind eine Spalte Datei_Pfad_neu schreiben. Das nächste Makro müsste also, wenn {Datei_Pfad_neu}>"", die Datei in Spalte {Datei} ausschneiden und mit dem neuen Pfad in Spalte {Datei_Pfad_neu} in das Verzeichnis Archiv einfügen.

Bernd

 

Hallo nochmal,

das Projekt ist schon fasst am laufen. Habe den Algoritmus hinbekommen der feststellt ob ein Vorgänger mit gleichem Namen vorhanden ist und gleich den neuen gewünschen Pfad mit gebildet. In der Spalte {Datei_Pfad_neu} steht jetzt vollständige neue Dateiname mit neuem Pfad. In der Spalte Datei_Pfad_alt[A] steht der vollständige alte Dateiname mit vollständigem Pfad. In Spalte J steht Ja wenn in Spalte I ein neuer Dateiname vorhanden ist.

Das Makro müsste jetalso, wenn {Datei_Pfad_neu}>"", die Datei in Spalte [A] ausschneiden und mit dem neuen Pfad in Spalte {Datei_Pfad_neu} in das Verzeichnis Archiv einfügen. Wäre das machbar?

Gruß
Bernd

 

Hallo Ratzmer,

wenn Du den alten Pfad und den neuen Pfad + Dateinamen hast, kanst Du eine Schleife über die Zellen machen und die VBA-Funktion FileCopy (siehe VBA Hilfe) verwenden. In etwa: FileCopy Alter_Pfad & "\" & Alte_Datei, Neuer_Pfad & "\" & Neue_Datei.

Das Löschen würde ich dann einmal manuell machen und nicht per Makro.

Gruß

 

Hi maninweb,

das macht mich noch nicht so richtig glücklich. Ich würde schon gern die dateien verschieben. Wenn der Copy Befehl geht, geht dann nicht auch CUT/PASTE? Etwa Cut pfad_alt &"\"datei_name paste Pfad_neu&\datei_name.

Gruß
Bernd

 

Hallo Bernd,

Du kannst die Quelldateien nach dem Kopieren auch per Code löschen. Nach dem Kopieren per FileCopy dann den Befehl Kill ausführen, z.B. Kill Pfad & "\" & Dateiname.

Gruß

 

Hi Maninweb,

habe schon mal ein bisschen vorgebastelt, bin aber nicht VBA sattelfest:

Meine Kopierroutine hat wohl wohl noch einige Syntaxfehler.

Sub Copy_dat()
Dim intRow As Integer
intRow = 2
Do While Cells(intRow, 1), >""
If Cells(intRow, 5), >""
FileCopy Cells(intRow, 5), Cells(intRow, 6)
End If
intRow = intRow + 1
Loop
MsgBox "Ende des Scheifenlaufs"
End Sub

Folgende Funktion soll die Scheife erfüllen:
In Spalte A stehen ab Zeile 2 Dateinamen. Deswegen der Start auf intRow 2.
Die do while Scheife soll prüfen ob in Zeile intRow, Spalte A was drin steht,
die nachfolgende If Bedingung prüft ob in Zeile intRow, Spalte H etwas drin steht,
wenn ja Filecopy des Dateinamens aus Zeile intRow Spalte (H) 5 und speichern unter den Name aus intRow Spalte 6
Wenn in Spalte A die zelle in intROW leer ist dann aussteigen.

Kannst Du da weiterhelfen?

Gruß
Bernd

 

Hallo Bernd,

der Code enthält ungültige Vergleiche, siehe Beispiel-Korrektur:

Sub Copy_dat()
Dim intRow As Integer
intRow = 2
Do While Len(Cells(intRow, 1).Value) > 0
If Len(Cells(intRow, 5).Value) > 0 Then
FileCopy Cells(intRow, 5).Value, Cells(intRow, 6).Value
End If
intRow = intRow + 1
Loop
MsgBox "Ende des Scheifenlaufs"
End Sub

Gruß

 

Hallo zusammen,

für die interessierten, das Projekt ist erledigt alle Verzeichnisse sortiert.

Die Makros für das Kopieren und Löschen sehen wie folgt aus:

Sub Copy_dat()
Dim lngRow As Long
Dim strOldFilename As String
Dim strNewFilename As String, strPruef As String
'Schleife ab Zeile 1 bis zur letzten Zeile
For lngRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'Alte Datei ermitteln aus Zelle lesen
strOldFilename = Cells(lngRow, 5).Text
strNewFilename = Cells(lngRow, 6).Text
strPruef = Cells(lngRow, 7).Text
If strPruef <> "ja" Then GoTo Raus
'kopieren
FileCopy strOldFilename, strNewFilename
Raus:
Next lngRow
End Sub
Sub Kill_dat()
Dim lngRow As Long
Dim strOldFilename As String
Dim strNewFilename As String, strPruef As String
'Schleife ab Zeile 1 bis zur letzten Zeile
For lngRow = 2 To Cells(Rows.Count, 1).End(xlUp).Row
'Alte Datei ermitteln aus Zelle lesen
strOldFilename = Cells(lngRow, 5).Text
strNewFilename = Cells(lngRow, 6).Text
strPruef = Cells(lngRow, 7).Text
If strPruef <> "ja" Then GoTo Raus
'kopieren
Kill strOldFilename
Raus:
Next lngRow
End Sub

Die Pfade und Dateien hole ich mit einem Makro von hajo, zerlege die Zeichenketten und prüfe ob die Datei die letzte ist. Die Makros starte ich dann im jeweiligen Arbeitsblatt

Bernd

Office 2010UK Version, Office 365, WIN XP, WIN 7