Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 349
  • Last Modified:

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

0
AndreasHermle
Asked:
AndreasHermle
  • 3
  • 2
1 Solution
 
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
 
AndreasHermleAuthor 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
 
gowflowCommented:
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
 
AndreasHermleAuthor 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

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now