• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need help with Folder Picker Code

Callie

New Member
Hello,

I was able to get this code to work at one point but now I am having problems.

The goal of the code is to allow the user to point to a folder that will contain various Excel files named Book1, Book2, Book3.... rename the files based on the contents in A1 and then close the files.

The code is allowing me to select a folder and select all of the files in the folder. Next the code appears to run and says Task Complete! but the file names are not changed.

I have attached 3 test files that are currently in the folder I am selecting.

Any help would be greatly appreciated.

Code:
Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com

Dim WB As Workbook
Dim myPath As String
Dim myfile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFilePicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = True
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & ""
    End With

'In Case of Cancel
NextCode:
  'myPath = "C:\Users\Callie"
  'If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx*"

'Target Path with Ending Extention
  myfile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
  Do While myfile <> ""
    'Set variable equal to opened workbook
      Set WB = Workbooks.Open(Filename:=myPath & myfile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents


        
    
     Dim newFileName As String
    newFileName = ActiveSheet.Range("A1").Value

    'Save and Close Workbook
    WB.Close SaveChanges:=True
    
    'Rename with new file name
    Name myPath & myfile As myPath & newFileName & Mid(myfile, InStrRev(myfile, "."))
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents

    'Get next file name
      myfile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
 

Attachments

  • Book1.xlsx
    7.9 KB · Views: 1
  • Book2.xlsx
    7.9 KB · Views: 0
  • Book4.xlsx
    7.9 KB · Views: 0
Read VBA inner help of Dir function.​
Try manually a well known path name : this function should returns the name when found.​
When Dir returns an empty string so nothing is found, the very most common case is its pathname parameter as not valid.​
The second case is when a not normal file is searched, like for example when hidden so in this case like explained in the VBA help​
you must well set its attributes parameter accordingly.​
First check during execution what contains your variable myPath following the code execution​
via step by step mode by hitting F8 key and check the variables contents in the Locals window.​
As the file dialog picker does not returns any path separator at the end of the string so it must be added as written in post #2 …​
And for a folder it's better to use the FileDialogFolderPicker. A must see …
 
Thank you, Marc. I appreciate the advice. This is probably beyond my experience level, so I will see if I can get up to speed by reading about this.
Best to you.
 
Back
Top