Add folder picker replacing file path

[Darren77]

Hello all

I have tried and failed to find a solution so have resorted to asking for help. I am trying to swap out the fso.getfolder file path for Application.FileDialog(msoFileDialogFolderPicker) which will determine the file path of the files i want to copy

I hope this make sense - very very new to VBA.
Many thanks


Sub TimePlanLog11()

Dim wb As Workbook
Dim fso As Object, f As Object, ff As Object, f1 As Object

Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")

'I want to change this section to be decided by a file picker

Set f = fso.Getfolder("C:\Users\clarkd02\AkzoNobel\Commercial Strategy and Planning - Project Management\Project Tracking\2023 PROJECT TRACKING\2. Grow the Category - Darren\2.3 Worth the Extra")

Set ff = f.Files
For Each f1 In ff
Set wb= Workbooks.Open(f1)

Sheets("TimePlan Log").Range("A3:F15" & Range("F65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(4).Activate
ThisWorkbook.Worksheets(4).Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
wb.Close SaveChanges:=False

Next
End Sub

 

[John_w]

Replace:

Set f = fso.Getfolder("C:\Users\clarkd02\AkzoNobel\Commercial Strategy and Planning - Project Management\Project Tracking\2023 PROJECT TRACKING\2. Grow the Category - Darren\2.3 Worth the Extra")

with:

    Dim folderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select folder"
        .InitialFileName = ThisWorkbook.Path
        If .Show Then
            folderPath = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With
    Set f = fso.GetFolder(folderPath)

 

[Darren77]

Replace:

Set f = fso.Getfolder("C:\Users\clarkd02\AkzoNobel\Commercial Strategy and Planning - Project Management\Project Tracking\2023 PROJECT TRACKING\2. Grow the Category - Darren\2.3 Worth the Extra")

with:

    Dim folderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select folder"
        .InitialFileName = ThisWorkbook.Path
        If .Show Then
            folderPath = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With
    Set f = fso.GetFolder(folderPath)

Amazing, its works perfectly. Thank you so much