( Hilfe benötigt ) Automatische Umbenennung von Dateinamen

Neo_84

Grünschnabel
Hallo zusammen,

ich habe leider nur sehr minimalistische Kenntnisse bei der Programmierung mit VB und brauche dringend ein Lösung zu folgendem Problem:

In einem Ordner ( z.B. Dokumente ) befinden sich lauter doc-Dateien, welche in ihrer Bezeichnung eine "fortlaufende Nummer" haben ( z.B. xxxx-0001-xxxx-xxxxxx.doc ). Diese befindet sich wie im Beispiel zu sehen ab der 6ten Stelle ( Bindestrich mitgezählt ) und umfasst max. 4 Stellen.

In einem weiteren Ordner ( z.B. Formulare ) befinden sich nun pdf-Dateien welche nur mit dieser "fortlaufenden Nummer" gekennzeichnet sind ( z.B. 0001.pdf ).

Ich möchte nun, dass Excel die Bezeichnung der doc-Dateien nimmt und die entsprechende pdf-Datei ( lt. fortlaufender Nummer ) mit dieser Bezeichnung überschreibt.

Beispiel:

XXXX-0001-XXXX-XXXXXX.doc

0001.pdf => XXXX-0001-XXXX-XXXXXX.pdf


Bis jetzt habe ich es nur geschafft den Ordnerinhalt in Excel einlesen zu lassen :(

Hier mein Makro:

Sub test()
On Error Resume Next
Application.ScreenUpdating = False
Dim strLookIn As String, lngi As Long, strFileName As String, strTemp As String
Dim objFso As Object, objFolder As Object, objSubFolder As Object, objFile As Object
strLookIn = InputBox("Bitte Pfad angeben", , "Q:\Q1-Intranet")
strFileName = "*.pdf"
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.getFolder(strLookIn)
Sheets("Tabelle1").Columns(1).ClearContents
For Each objSubFolder In objFolder.SubFolders
lngi = lngi + 1
Sheets("Tabelle1").Cells(lngi, 1) = objFso.GetBaseName(objSubFolder)
Next
For Each objFile In objFolder.Files
strTemp = objFso.GetFileName(objFile)
If strTemp Like strFileName Then
lngi = lngi + 1
Sheets("Tabelle1").Cells(lngi, 1) = strTemp
End If
strTemp = vbNullString
Next
Set objFso = Nothing
Set objFolder = Nothing
Application.ScreenUpdating = True
End Sub

( Es ist natürlich nicht nötig mein bis jetzt erstelltes Makro beizubehalten! )

Es würde mich sehr freuen wenn mir jemand bei diesem Problem helfen könnte!

Mfg,

Georg
 
Nix hier von ist getestet. Verwendung auf eigene Gefahr!

Code:
Sub ReName(ByRef DocDir as string, ByRef PDFDir as String)
Dim FileName as string
Dim tmpFile() as String
Dim i as long

     FileName=Dir(DocDir & "\*.doc")
     
     If FileName<>"" then

     Do

          tmpFile=Split(FileName,".") 'Wir trennen den Dateinamen von der Endung DOC
          FileName=""
          For i=0 to Ubound(tmpFile)-1

'Hier bauen wir den Dateinamen wieder zusammen nur ohne Endung
'Ein Dateiname kann mehrere Punkte enthalten. Deshalb die Schleife
                FileName=FileName & tmpFile(i)       
          Next

          tmpFile=Split(FileName,"-")     'Wir zerpflücken den Dateinamen an den Bindestrichen

'Name As ist die VB-Anweisung eine Datei aus dem Code heraus umzubenennen
         Name PDFDir & "\" & tmpFile(1) & ".pdf" as FileName & ".pdf"

          FileName=Dir   'Hole nächstes Doc
     Loop until FileName=""
     End IF

End Sub

Aufruf mit ReName "c:\Dokumente","c:\Formulare" oder wie auch immer deine Ordner heissen
 
Zuletzt bearbeitet:
Wie bereits geschrieben...meine VB-Kenntnisse sind schlecht!
Das dargelegte Makro habe ich aus einem Forum kopiert und abgeändert.

Was genau meinst du mit Aufrufen mit ReName?

Die Verzeichnisse lauten genau:


Für die doc-Dateien:
Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008

Für die pdf-Dateien:
Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien

Muss ich dein Makro mit meinem zusammen starten oder ist bei deinem schon alles dabei? Sorry wegen meinen "nicht" vorhandenen Kenntnissen!

Danke dir schon mal im Vorraus für dein Verständnis
 
Es kommen hier laufend neue doc-Dateien und dazugehörige pdf-Dateien dazu.
Deshalb wäre es von Vorteil wenn dieses Programm automatisiert werden könnte.

Soll heißen, wenn es automatisch ( evtl. täglich oder wöchentlich ) starten würde und alle neu angelegten Datein entsprechen umbenennt.

Falls dies nicht so leicht möglich ist, wäre es auch ok wenn ich das Excel-Dokument manuel starte und durchlaufen lasse!
 
Für die doc-Dateien:
Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008

Für die pdf-Dateien:
Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien

Muss ich dein Makro mit meinem zusammen starten oder ist bei deinem schon alles dabei? Sorry wegen meinen "nicht" vorhandenen Kenntnissen!

Danke dir schon mal im Vorraus für dein Verständnis

Nein, dein Makro kannst du löschen

Es kommen hier laufend neue doc-Dateien und dazugehörige pdf-Dateien dazu.
Deshalb wäre es von Vorteil wenn dieses Programm automatisiert werden könnte.

Soll heißen, wenn es automatisch ( evtl. täglich oder wöchentlich ) starten würde und alle neu angelegten Datein entsprechen umbenennt.

Falls dies nicht so leicht möglich ist, wäre es auch ok wenn ich das Excel-Dokument manuel starte und durchlaufen lasse!

Hmmm, dann sollte man aber noch einen Test einbauen, ob eine PDF-Datei bereits umbenannt worden ist, ansonsten werden bereits umbenannte wieder umbenannt.

OK!
In Excel:
Spring im Visual Basic Editor in die Code-Ebene von "DieseArbeitsmappe" (Doppelclick drauf). Wähle dort das Objekt "Workbook" aus (linkes DropDown-Feld). Normalerweise solltest du jetzt folgenden Funktionsrumpf sehen:
Code:
Private Sub Workbook_Open()

End Sub

In diesen Funktionsrumpf trägst du jetzt wie folgt ein, damit er dann hinterher so aussieht:
Code:
Private Sub Workbook_Open()

ReName "Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008","Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien"

End Sub

Unterhalb diese Funktion (unter dem "End Sub") kopierst du meine Funktion von oben rein. Der vollständige Code innerhalb von DieseArbeitsmappe sieht dann so aus:
Code:
Private Sub Workbook_Open()

ReName "Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008","Q:\Q1-Office\40-Fähigkeitsuntersuchungen\20-U-Berichte 2000-2007\Uber2008\_PDF-Dateien"

End Sub

Sub ReName(ByRef DocDir as string, ByRef PDFDir as String)
Dim FileName as string
Dim tmpFile() as String
Dim i as long

     FileName=Dir(DocDir & "\*.doc")
     
     If FileName<>"" then

     Do

          tmpFile=Split(FileName,".") 'Wir trennen den Dateinamen von der Endung DOC
          FileName=""
          For i=0 to Ubound(tmpFile)-1

'Hier bauen wir den Dateinamen wieder zusammen nur ohne Endung
'Ein Dateiname kann mehrere Punkte enthalten. Deshalb die Schleife
                FileName=FileName & tmpFile(i)       
          Next

          tmpFile=Split(FileName,"-")     'Wir zerpflücken den Dateinamen an den Bindestrichen

'Name As ist die VB-Anweisung eine Datei aus dem Code heraus umzubenennen
         Name PDFDir & "\" & tmpFile(1) & ".pdf" as FileName & ".pdf"

          FileName=Dir   'Hole nächstes Doc
     Loop until FileName=""
     End IF

End Sub
 
Okay....ich hab jetzt dein Makro eingefügt und dann über "Sub/UserForm ausführen" gestartet.

Hierbei habe ich im oberern Teil ( Workbook ) die ReName Adressen zu Testzwecken geändert und in diese Testordner ein doc bzw pdf geladen.
Jedoch wurde hierbei der Name des Pdf´s nicht geändert!

Mach ich vielleicht etwas falsch?
 
Hab es gerade eben mit dem Einzelschrittverfahren durchlaufen lassen.
Nach der Zeile...

Name PDFDir & "\" & tmpFile(1) & ".pdf" As FileName & ".pdf"

kommt folgende Fehlermeldung:

Laufzeitfehler '53':
Datei nicht gefunden

PS: Die PDF´s haben nicht das Format "0001.pdf" sondern "2008-0001.pdf". Die 4 Ziffern davor geben noch das Jahr an.
 
PS: Die PDF´s haben nicht das Format "0001.pdf" sondern "2008-0001.pdf". Die 4 Ziffern davor geben noch das Jahr an.

AHA! Wieso sagst du das nicht gleich Im ersten Post hast du das Namensformat mit 0001.pdf angegeben. Natürlich kann es ja dann nicht gehen. Nach welchem Kriterium wird das Jahr für das PDF vergeben? Kann es mehrere PDF's mit JJJJ-0001.pdf geben (Bsp. 2007-0001.pdf und 2008-0001.pdf)?
 

Neue Beiträge

Zurück