Option Explicit
Sub MultiRename()
Dim strPath As String ' der Pfad der Dateien mit \ am Ende
Dim d As Date ' der 1. des Vormonats
Dim i As Long ' Zeilenzähler
Dim j As Long ' zählt vorhandene Dateien
Dim strOldName As String ' der alte Dateiname aus Spalte A
Dim strNewName As String ' der neue Dateiname aus Spalte B
On Error GoTo ErrHandler ' Fehlerhehandlung, kann hier nicht schaden
d = DateSerial(Year(Date), Month(Date) - 1, 1)
strPath = Range("B1").Value
If Dir(strPath & ".") = "" Then ' Wenn es kein '.' gibt ist das kein Verzeichnis
MsgBox "No Path"
Exit Sub
End If
j = 0
' Ab Zeile 4 alle Dateien umbenennen
For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
strOldName = strPath & Cells(i, 1).Value
strNewName = strPath & Cells(i, 2).Value & " " & Format(d, "mmmm yyyy") & ".pdf"
If Dir(strOldName) <> "" Then
j = j + 1
Name strOldName As strNewName
End If
Next
MsgBox j & " Dateien gefunden.", vbInformation, "MutiRename"
ErrHandler:
If Err.Number Then
MsgBox Err.Description, , Err.Number
Resume Next
End If
End Sub
---------------------------------------------------------------------------
Hi Leute,
kann mir jemand von Euch vielleicht weiterhelfen? Oben seht ihr, wie weit ich bisher gekommen bin. Grob gesagt geht es darum, dass Dateinamen monatlich geändert werden. Dabei ist die Endung des neuen Dateinamens immer nach folgender Systematik aufgebaut: "Aktueller Monat - 1, aktuelles Jahr"
Also z.B. , wenn ich im März 2012 das Makro durchlaufen lasse, heißen die Dateien am Ende des Dateinamens jeweils immer "Februar 2012", im April dann "März 2012" usw.
Alles schön und gut, nur hätte ich gerne die Monate in ENGLISCH anstatt auf DEUTSCH !
Any ideas?
Danke
Adriano
|