Office: Beliebige Arten von Dateien auslesen und umbenennen

Hi zusammen,

ich komme einfach mit einer Programmierung über Excel VBA nicht weiter. ich habe schon verschiedene Lösungswege versucht, aber komme zu keiner Lösung. Vielleicht kann mir hier jemand weiterhelfen.

Und zwar habe ich das Problem, dass ich verschiedene Dateien in einem Ordner habe, die ich umbenennen will. Ich will allerdings nur zwei Zeichen verändern und es sind verscheidene Arten von Dateien.

Zum Beispiel:
H:\Test\15050M17330_b_5M_Rev1p0.rir
H:\Test\15050M17330_b_5M_Rev1p0.src
H:\Test\15050M17330_b_5M_Rev1p0_asap.dis
H:\Test\15050M17330_b_5M_Rev1p0_Fred.dat

Der Name soll so umbenannt werden: H:\Test\15050M173300_B_Rev1p0.*
Es wird also nur eine Null hinzugefügt und aus "b" wird "B". Dabei soll es egal sein, was vor dem ersten Unterstrich "_" und nach "Rev1p0" steht.

Sub Dateiumbenennen()
Dim appWord As Object
Dim doc As Object

Set appWord = CreateObject("Word.Application")
Set doc = appWord.Documents.Add("H:\Test\*_b_5M_Rev1p0*")
appWord.Visible = True

docs.SaveAs "H:\Test\*0_B_5M_Rev1p0*"

Set appWord = Nothing
Set doc = Nothing

End Sub

Das hier war mein Ansatz, aber er funktioniert nicht, egal was ich abändere. Cool wäre es auch, wenn das Programm das Laufwerk durchsucht und alle Dateien in allen Ordnern, die den Mittelteil "_5M_Rev1p0" beinhalten, so wie oben beschrieben umbenennt.

Ich hoffe mir kann jemand weiterhelfen. Danke schonmal im Voraus!

 

Hallo,

und was ist mit "5M_"? Müssen diese Zeichen vorher im Dateinamen enthalten sein bzw. können dort auch andere Zeichen vorher enthalten sein bzw. müssen sie offenbar hinterher entfernt werden?
Diese Änderung (bzw. Nicht-Änderung) kommentierst du nicht !?

 

Hallo,
Gerade, wenn Du verschiedene Dateitypen umbenennen möchtest kannst Du die nicht alle mit Word öffnen!
Dazu gab und gibt es Funktionen, welche direkt im Dateisystem arbeiten.
Nachdem Application.FileSearch leider nicht mehr existiert und die Funktion Dir() nicht rekursiv einsetzbar ist, hier eine Lösung per FileSystemObject.

Aber Vorsicht! Extrem viele Dateien könnten einen Überlauf verursachen und/oder Dein System einfrieren.
Auch deshalb habe ich mal vor jedes Umbenennen eine Abfrage gestellt.
Dass man in C:\ nicht alles was ein X enthält in ein Y umbenennen sollte versteht sich hoffentlich.

Code:

Option Explicit

Dim fso As Object

Public Sub Start()
 'Startet RenameFiles mit Werten aus Tabelle1
 Call RenameFiles(Tabelle1.Range("A3"), _
                  Tabelle1.Range("B3"), _
                  Tabelle1.Range("B1"), _
                  Tabelle1.Range("C3") = "X")
                  'Tabelle1.cbSubs.Value)
End Sub

Private Sub RenameFiles(sFind As String, _
                        sReplace As String, _
                        Optional sDir As String = "", _
                        Optional bSub As Boolean = False)

'Achtung: fso muss oben als globale Variable deklariert werden!
Set fso = CreateObject("Scripting.FileSystemObject")
Dim cFiles As New Collection 'Geht auch (umständlicher) mit einem Aray
Dim fFull As Variant 'Variant einfacher für For-Schleife
Dim fPath As String, fName1 As String, fName2 As String
Dim ret As Integer
Dim i As Long
Dim s As String

 'Falls Verzeichnis nicht angegeben, dann User fragen
 If sDir = "" Then
  With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
   .Show
   If .SelectedItems.Count > 0 Then
    sDir = .SelectedItems(1)
   Else
    ret = MsgBox("Kein Pfad angegeben. Ausführung abgebrochen", vbExclamation, "Fehler")
    Exit Sub
   End If
  End With
 End If
 
 'Alle Dateinamen sammeln
 CollectFiles fso.getfolder(sDir), bSub, cFiles
 ret = MsgBox(CStr(cFiles.Count) + " Dateien gefunden", vbOKOnly, "Information")
 
 i = 0
 'Alle gefundenen Dateien durch gehen
 For Each fFull In cFiles
  'Pfad abschneiden (Text soll nur in Dateinamen ersetzt werden)
  fName1 = Right(fFull, InStr(1, StrReverse(fFull), "\") - 1)
  'Prüfen, ob Suchstring in Dateiname enthalten ist
  If InStr(fName1, sFind) > 0 Then
   'Pfad extrahieren
   fPath = Left(fFull, Len(fFull) - Len(fName1))
   'Text ersetzen und Pfad davor setzen
   fName2 = fPath + Replace(fName1, sFind, sReplace)
   If MsgBox("Umbenennen von/in ?" & vbCrLf + fFull + vbCrLf + fName2, vbYesNo, "Umbenennen") = vbYes Then
    'Datei umbenennen
    i = i + 1
    Name fFull As fName2
   End If
  End If
 Next
ret = MsgBox(CStr(i) + " Dateien umbenannt", vbOKOnly, "Information")
End Sub

Private Sub CollectFiles(ByVal cDir As Object, bRec As Boolean, ByRef coll As Collection)
Dim file As Variant, subfolder As Variant
 For Each file In cDir.Files
  'Vollen Dateiname in Collection aufnehmen
  coll.Add file.Path
 Next
 If bRec Then
  For Each subfolder In cDir.subfolders
   'Sub rekursiv mit nächstem Unterverzeichnis starten
   CollectFiles subfolder, True, coll
  Next
 End If
End Sub