Change directory with user needs

[Ulisses_Carso]

Hello everyone!

I have this code (which I found on the internet due to my rush) that merges all the files in the directory into a single one, but in it I need to force the directory to make it work, I need to make the user able to select the directory manually.

I managed to get the path with the code below, I just can't include it in the existing code.

Can anyone one tell me what i have to do please?


Obs: I don't need to select the files inside the directory, the code selects them all as it should be.


Code I made to get folder path.

FolderPath as String
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count > 0 Then
        FolderPath = .SelectedItems(1)
    End If
End With

Full code

Sub MergeFiles()

Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
Application.ScreenUpdating = False

'Line i need to change
Set dirObj = mergeObj.Getfolder("forced folder path")

Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
 
Range("A2:IV" & Range("A100000").End(xlUp).Row).Copy
Workbooks("Master.xlsx").Sheets("Master").Activate
 
Range("A300000").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
Application.ScreenUpdating = True

End Sub

 

[Fluff]

How about

Sub MergeFiles()

Dim bookList As Workbook
Dim FolderPath As String
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
Application.ScreenUpdating = False
With Application.FileDialog(4)
   .AllowMultiSelect = False
   If .Show Then
      FolderPath = .SelectedItems(1)
   Else
      Exit Sub
   End If
End With
'Line i need to change
Set dirObj = mergeObj.Getfolder(FolderPath & "\")

Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
 
Range("A2:IV" & Range("A100000").End(xlUp).Row).Copy
Workbooks("Master.xlsx").Sheets("Master").Activate
 
Range("A300000").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
Application.ScreenUpdating = True

End Sub

 

[Ulisses_Carso]

How about

Sub MergeFiles()

Dim bookList As Workbook
Dim FolderPath As String
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 
Application.ScreenUpdating = False
With Application.FileDialog(4)
   .AllowMultiSelect = False
   If .Show Then
      FolderPath = .SelectedItems(1)
   Else
      Exit Sub
   End If
End With
'Line i need to change
Set dirObj = mergeObj.Getfolder(FolderPath & "\")

Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
 
Range("A2:IV" & Range("A100000").End(xlUp).Row).Copy
Workbooks("Master.xlsx").Sheets("Master").Activate
 
Range("A300000").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
Application.ScreenUpdating = True

End Sub

It worked perfectly, thanks dude!!

 

[Fluff]

You're welcome & thanks for the feedback.