Macro for renaming fiiles

Can you fill in these details :

File Name Currently :

File Name Required :

Every file name is different in the folder.

So file 1 is called Expense report Sep_13_Corp financial Accounting

File 2 Expense report Sep_13_Corp Premises

In folder 2 the corp part will be replaced. However up to the date part they are always the same in every file.

I want to change the "Sep_13" part with the current month part (based on the month I selected in the original macro see above), so for this mont I am doing Dec (= wb1.Sheets("Sheet1").Range("G4")
)

The occurrence of _ (underscore) is only when you have month_year_description, does it occur otherwise ?

Please test this code to see if this is what we are trying to achieve.

Sub in_file()
'code by xlbiznes
Dim fl_name As String
Dim target_str As String
fl_name = "Sep_13_Corp financial Accounting"
If InStr(1, fl_name, "_") > 0 Then
    target_str = Mid(fl_name, InStr(1, fl_name, "_") - 3, 6)
End If
MsgBox "before : " & fl_name & vbCrLf & "after :" & Replace(fl_name, target_str, "testing")

'in your actual code you will use
'Replace(fl_name, target_str, wb1.Sheets("Sheet1").Range("G4"))

End Sub

try this code, i have made changes to your code and added some extra lines to save the file as needed.

  Sub macro_1()
Dim fl_name As String
Dim target_str As String
  
  Dim wb1, wb2, month_name, fs, fol, fil
  Set wb1 = ActiveWorkbook
 Set fs = CreateObject("Scripting.filesystemobject")
  Set fol = fs.getfolder("U:\Outlooksoft\Europe\2013\Financial Reporting\ACTUAL Monthly results\12_Dec_13\Manager Expense Reports\Corp") ' change path as appropriate

  For Each fil In fol.Files
      Set wb2 = Workbooks.Open(fil)
     wb2.Sheets("PERIODIC").Range("B63") = wb1.Sheets("Sheet1").Range("G4")
     Application.Run ("mnu_etools_refresh")



      Application.DisplayAlerts = False
      
    'new code added
    fl_name = fil
    If InStr(1, fl_name, "_") > 0 Then
    target_str = Mid(fl_name, InStr(1, fl_name, "_") - 3, 6)
    'MsgBox wb1.Sheets("Sheet1").Range("G4")
    fl_name = Replace(fl_name, target_str, wb1.Sheets("Sheet1").Range("G4").Text)
    End If
    'new code ends
    wb2.SaveAs fl_name 'save file with the new name
    
     wb2.Close True
    Application.DisplayAlerts = True

 Next

End Sub

Ok,

i think the issue is with this line,

  Set fol = fs.getfolder("U:\Outlooksoft\Europe\2013\Financial Reporting\ACTUAL Monthly results\12_Dec_13\Manager Expense Reports\Corp") ' change path as appropriate

as there is \12_DEC_13\ in the folder string , i think this is being renamed and results in an error.

Can you check what fl_name is holding ,during the debug process.

No issues,

this will take care.

Sub macro_1()
Dim fl_name As String
Dim target_str As String
  
  Dim wb1, wb2, month_name, fs, fol, fil
  Set wb1 = ActiveWorkbook
  Set fs = CreateObject("Scripting.filesystemobject")
  Set fol = fs.getfolder("U:\Outlooksoft\Europe\2013\Financial Reporting\ACTUAL Monthly results\12_Dec_13\Manager Expense Reports\Corp") ' change path as appropriate

  For Each fil In fol.Files
      Set wb2 = Workbooks.Open(fil)
     wb2.Sheets("PERIODIC").Range("B63") = wb1.Sheets("Sheet1").Range("G4")
     Application.Run ("mnu_etools_refresh")
      Application.DisplayAlerts = False
    'new code added
    fl_name = wb2.Name
    If InStr(1, fl_name, "_") > 0 Then
    target_str = Mid(fl_name, InStr(1, fl_name, "_") - 3, 6)
    'MsgBox wb1.Sheets("Sheet1").Range("G4")
    fl_name = Replace(fl_name, target_str, wb1.Sheets("Sheet1").Range("G4").Text)
    End If
    fl_name = ActiveWorkbook.Path & "\" & fl_name
    'new code ends
    wb2.SaveAs fl_name 'save file with the new name
     wb2.Close True
    Application.DisplayAlerts = True
 Next

End Sub

what is the contents of the G4 ? Why is it DECP ? lets tackle this first.

We can use the filesystemobject to simply rename the files in the list using the new replace logic.

try this new code, that would rename your file, You need to check the contents of g4 as we are using that to replace the month_year part of your file.

Sub macro_1()
Dim fl_name As String
Dim target_str As String
  
  Dim wb1, wb2, month_name, fs, fol, fil
  Set wb1 = ActiveWorkbook
  Set fs = CreateObject("Scripting.filesystemobject")
  Set fol = fs.getfolder("U:\Outlooksoft\Europe\2013\Financial Reporting\ACTUAL Monthly results\12_Dec_13\Manager Expense Reports\Corp") ' change path as appropriate

  For Each fil In fol.Files
      Set wb2 = Workbooks.Open(fil)
     wb2.Sheets("PERIODIC").Range("B63") = wb1.Sheets("Sheet1").Range("G4")
     Application.Run ("mnu_etools_refresh")
      Application.DisplayAlerts = False
    'new code added
    fl_name = wb2.Name
    If InStr(1, fl_name, "_") > 0 Then
    target_str = Mid(fl_name, InStr(1, fl_name, "_") - 3, 6)
    'MsgBox wb1.Sheets("Sheet1").Range("G4")
    fl_name = Replace(fl_name, target_str, wb1.Sheets("Sheet1").Range("G4").Text)
    End If
    fl_name = ActiveWorkbook.Path & "\" & fl_name
    'new code ends
     wb2.Close True
     fs.movefile fil, fl_name
    Application.DisplayAlerts = True
 Next

End Sub

Can you check this line of code and add a msgbox below that to see whats happening.

 fl_name = Replace(fl_name, target_str, wb1.Sheets("Sheet1").Range("G4").Text)

msgbox  "orginal name : " &  fl_name & vbcrlf & "String to Replace: " & target_Str & vbcrlf & wb1.Sheets("Sheet1").Range("G4").Text

can you post the code that is in question ?

What is the original file name ?

can you change this code

from

target_str = Mid(fl_name, InStr(1, fl_name, "_") - 3, 6)

to

target_str = Mid(fl_name, InStr(1, fl_name, ".") - 4, 8)

You are welcome, Its nice that we achieved , what you wanted.

if you are satisfied with the solution, please mark this thread as solved.