Extend file name

[Sarvottam]

Hi

I am looking for a macro which will open all files from specified folder and rename files which is just extension to the existing file name.

Example-

If file name is GRIR report – It should be changed as “GRIR report as of 01312018”
If file name is AR aging report – It should be changed as “AR aging report as of 01312018” .

Basically my date will change each month rest file name will be same.

 

[ranman256]

run: RenameAllFiles
alter the date in the 2nd param to the date you want to use.

Public Sub RenameAllFiles()
getFilesInDir "c:\temp\", Date
End Sub


Public Sub getFilesInDir(ByVal pvDir, ByVal pvDate)
Dim FSO, oFolder, oFile, oRX
Dim sFile As String
Dim vDat, vTarg, vExt, vPrefix
Dim i As Integer


On Error GoTo errGetFiles


If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
If Not IsDate(pvDate) Then
End If


vDat = Format(pvDate, "mmddyyyy")


Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvDir)


For Each oFile In oFolder.Files
   If InStr(oFile.Name, ".xls") > 0 Then   'ONLY xl files
          'open file here
      sFile = oFile
      i = InStrRev(oFile, ".")
      vPrefix = Left(oFile, i - 1)
      vExt = Mid(oFile, i)
      vTarg = vPrefix & " report as of " & vDat & vExt
      
      Name sFile As vTarg
   End If
Next


endit:
Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
Exit Sub


errGetFiles:
 MsgBox Err.Description, , Err
Resume endit
Resume
End Sub