PDA

View Full Version : renaming all files in folder & subfolder with name & date



devesh123
01-11-2012, 11:16 PM
Hi


Please help me in macro which can rename all the files in folder & subfolder with filename_current date.

eg;

Folder path : C:\abc
Subfolder : C\abc\1
C\abc\2


current file name : filename1, filename2
new file name : filename1_12012012, filename2_12012012




Thanks in advance.

mancubus
01-12-2012, 01:52 AM
wellcome to vBAX.

assuming 12012012 is today's date in ddmmyyyy format, test below code with sample files first.


Sub RenAllFilesInclSubFold()
'http://vbaexpress.com/forum/showthread.php?t=40479

Dim fso As Object, fold As Object, fFile As Object
Dim fPath As String, fName As String, oldName As String, newName As String

fPath = "C:\abc"
'
'ren files in parent folder
fName = Dir(fPath & "\" & "*.xl*", vbNormal)
Do While fName <> ""
oldName = Left(fName, InStrRev(fName, ".") - 1)
newName = Replace(fName, oldName, oldName & "_" & Format(Date, "ddmmyyyy"))
Name fPath & "\" & fName As fPath & "\" & newName
fName = Dir
Loop
'
'ren files in subfolders
Set fso = CreateObject("Scripting.FileSystemObject")
Set fold = fso.GetFolder(fPath)
For Each fFile In fold.subfolders
fName = Dir(fFile.Path & "\*.xl*", vbNormal)
Do While fName <> ""
oldName = Left(fName, InStrRev(fName, ".") - 1)
newName = Replace(fName, oldName, oldName & "_" & Format(Date, "ddmmyyyy"))
Name fFile.Path & "\" & fName As fFile.Path & "\" & newName
fName = Dir
Loop
Next

End Sub



if 12012012 is not today's date then replace this line
newName = Replace(fName, oldName, oldName & "_" & Format(Date, "ddmmyyyy"))



with

newName = Replace(fName, oldName, oldName & "_12012012"))

mohanvijay
01-12-2012, 01:56 AM
try this



Sub Ma_Name()

Dim Dlg_Fol As FileDialog
Dim T_Str As String
Set Dlg_Fol = Application.FileDialog(msoFileDialogFolderPicker)
If Dlg_Fol.Show = -1 Then
T_Str = Dlg_Fol.SelectedItems(1)
Else
MsgBox "Please Seelct folder"
Set Dlg_Fol = Nothing
Exit Sub
End If
Set Dlg_Fol = Nothing
Dim FSO As Object
Dim MA_Fol As Object, Su_Fol As Object
Dim T_Name As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set MA_Fol = FSO.GetFolder(T_Str)
File_Namer MA_Fol
For Each Su_Fol In MA_Fol.SubFolders
File_Namer Su_Fol
Next
Set Su_Fol = Nothing
Set MA_Fol = Nothing
Set FSO = Nothing

End Sub


Sub File_Namer(Fol As Object)

Dim Ob_Fi As Object
Dim T_Str As String
Dim T_Name As String
T_Str = Format(Now, "_ddmmyyyy")
For Each Ob_Fi In Fol.Files
T_Name = Ob_Fi.Name
Ob_Fi.Name = Left(T_Name, InStrRev(T_Name, ".") - 1) & T_Str & _
Right(T_Name, Len(T_Name) - (InStrRev(T_Name, ".") - 1))
Next

End Sub

devesh123
01-13-2012, 01:49 AM
Thanks..... :)
:yes