Public Sub ChangeFileNames()
Dim oFSO As Object
Dim newFileName As String
Dim newFileName0 As String
Dim fil
Const PATH_TO_FOLDER As String = "C:\Users\glendon\Documents\EXCEL\testDemo"
Const SOURCE_SHEET_NAME = "Sheet1"
Set oFSO = CreateObject("Scripting.FileSystemObject")
For Each fil In oFSO.GetFolder(PATH_TO_FOLDER).Files
If fil.Name Like "*.xls*" Then
newFileName = GetInfoFromClosedBook(PATH_TO_FOLDER, fil.Name, SOURCE_SHEET_NAME, 1, 1) & "." & Split(fil.Path, ".")(1)
newFileName = Replace(newFileName, ":", "_")
newFileName = Replace(newFileName, " ", "_")
newFileName = Replace(newFileName, "-", "_")
newFileName = Format(Now(), "Mmm") & "_" & newFileName
newFileName0 = GetInfoFromClosedBook(PATH_TO_FOLDER, fil.Name, SOURCE_SHEET_NAME, 5, 1) & "." & Split(fil.Path, ".")(1)
newFileName0 = newFileName0 & "_" & newFileName
oFSO.moveFile fil.Path, PATH_TO_FOLDER & newFileName0
End If
Next fil
End Sub
Public Function GetInfoFromClosedBook(Path, FileName, SheetName, RowNum, ColNum)
GetInfoFromClosedBook = ExecuteExcel4Macro("'" & Path & "[" & FileName & "]" & SheetName & "'!R" & RowNum & "C" & ColNum)
End Function
Bookmarks