Incorporate a folder picker in existing macro code

Dear Experts:

below code performs a batch renaming of files by using cell values in Column A and Column B of the active worksheet (Column A values = old name; Column B values = new file name)

I would like to have a 'folder picker' incorporated in that code but I got no idea how this is coded.

I would appreciate it very much if somebody could help me with this.

Thank you very much in advance.

Regards, Andreas


Public Sub RenameFiles()

    Dim fso As Scripting.FileSystemObject
    Dim vFiles As Variant
    Dim i As Long
    Dim oFile As Scripting.File
    Dim sFilePath As String
    
    Const cFILE_PATH As String = "C:\Temp"
    
    Set fso = New Scripting.FileSystemObject
    
    vFiles = ActiveSheet.Cells(1).CurrentRegion.Value
    
    For i = 1 To UBound(vFiles, 1)
    
        With fso
            sFilePath = .BuildPath(cFILE_PATH, vFiles(i, 1))
            If .FileExists(sFilePath) Then
                Set oFile = .GetFile(sFilePath)
                
                oFile.Name = vFiles(i, 2)
                
            End If
        End With
    
    Next i

End Sub

Open in new window

Andreas HermleTeam leaderAsked:
Who is Participating?
 
gowflowConnect With a Mentor Commented:
have your Sub and my Function in a Module and then yes


here it is

Public Sub RenameFiles()

    Dim fso As Scripting.FileSystemObject
    Dim vFiles As Variant
    Dim i As Long
    Dim oFile As Scripting.File
    Dim sFilePath As String
    Dim fFolder as String

    'Const cFILE_PATH As String = "C:\Temp"
    fFolder = GFolderName("Please Choose a Folder")

    
    Set fso = New Scripting.FileSystemObject
    
    vFiles = ActiveSheet.Cells(1).CurrentRegion.Value
    
    For i = 1 To UBound(vFiles, 1)
    
        With fso
            sFilePath = .BuildPath(fFolder , vFiles(i, 1))
            If .FileExists(sFilePath) Then
                Set oFile = .GetFile(sFilePath)
                
                oFile.Name = vFiles(i, 2)
                
            End If
        End With
    
    Next i

End Sub 

Open in new window


try it and let me know.
gowflow
0
 
gowflowCommented:
Well here it is:

This  Function will return the folder that the user chosses

Function GFolderName(fol As String) As String
Dim vrtSelectedItem

With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.ActiveWorkbook.Path
    .Title = "Please choose Folder location for: " & fol
    .InitialView = msoFileDialogViewDetails
    .Show
    
    
    For Each vrtSelectedItem In .SelectedItems
    GFolderName = vrtSelectedItem & "\"
    Next vrtSelectedItem
End With

Set vrtSelectedItem = Nothing

End Function

Open in new window


and you call this function like this
fFolder = GFolderName(Title)

So it returns the Folder in the variable fFolder and you call it with a value in Title that will be what you want to show when the dialog box opens up something like
Title = "Please Choose Folder"

Rgds/gowflow
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi gowflow,

thank  you very much for your swift and professional support. As a matter of fact, I do not know how to 'merge' these two codes, i.e. how the 'calling' actually has to be done and I am sure the initial code also has to be changed, at least line 9 has to be deleted, am I right.

Regards, Andreas
0
 
Andreas HermleTeam leaderAuthor Commented:
Hi gowflow,

great this did the trick. Thank you very much for your professional and swift help.

I really appreciate it.

Regards, Andreas
0
 
gowflowCommented:
Your most welcome and glad I could help
gowflow
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.