Query user to choose path - vba

Question

I have a code that reads a folder contents (only other folders) and lists them into excel in a certain range.
The problem is that the path where the code reads contents (/CtrExtrase) is given in the code.
I need the path to be choosen by the user. Tried and failed totally.
My code:
Sub distribuire_foldere()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
'CLEARS ALL PREVIOUS CONTENT
Sheets("DISTRIBUIRE foldere").Range("A2:A2000").ClearContents
'INSERTS IN CELL THE PATH WHERE THE SCRIPT IS READING
Sheets("DISTRIBUIRE foldere").Range("$E$1").Value = ThisWorkbook.path & "\CtrExtrase"
' LISTS THE CONTENT OF THE CHOOSEN FOLDER
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
On Error GoTo nuexistafolderul
'THIS IS THE PROBLEM, AS I NEED THE USER TO CHOOSE THE PATH:
Set objFolder = objFSO.GetFolder(Application.ThisWorkbook.path & "\CtrExtrase")
i = 1
'loops through each folder in the directory and prints their names
On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
For Each objSubFolder In objFolder.subfolders
Application.StatusBar = objSubFolder.path & " " & objSubFolder.Name
'OUTPUTS THE FOLDERS NAME
Cells(i + 1, 1) = objSubFolder.Name
i = i + 1
Next objSubFolder
handleCancel:
If Err = 18 Then
MsgBox "Ai anulat procesul inainte de finalizare! Reia procedura!"
nuexistafolderul:
MsgBox "Nu exista folderul pentru extractia contractelor! Extrage intai contractele!"
End If
'CALLS A MODULE THAT INSERTS CERTAIN TEXT INTO A BATCH FILE
Call Module1.batchfile2
End Sub

Answer 1

Use FileDialog with FolderPicker, here it's wrap in a function :
Function GetFolder(Optional strPath As String = "C:\") As String
Dim fldr As FileDialog
Dim sItem As String
GetFolder = vbNullString
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
And your code, you can set the default path in GetFolder(ThisWorkbook.Path & "\") :
Sub distribuire_foldere()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubFolder As Object
Dim i As Integer
'CLEARS ALL PREVIOUS CONTENT
Sheets("DISTRIBUIRE foldere").Range("A2:A2000").ClearContents
'INSERTS IN CELL THE PATH WHERE THE SCRIPT IS READING
Sheets("DISTRIBUIRE foldere").Range("$E$1").Value = ThisWorkbook.Path & "\CtrExtrase"
' LISTS THE CONTENT OF THE CHOOSEN FOLDER
Application.StatusBar = ""
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
On Error GoTo nuexistafolderul
'THIS IS THE PROBLEM, AS I NEED THE USER TO CHOOSE THE PATH:
Set objFolder = objFSO.GetFolder(GetFolder(ThisWorkbook.Path & "\"))
i = 1
'loops through each folder in the directory and prints their names
On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler
For Each objSubFolder In objFolder.SubFolders
Application.StatusBar = objSubFolder.Path & " " & objSubFolder.Name
'OUTPUTS THE FOLDERS NAME
Cells(i + 1, 1) = objSubFolder.Name
i = i + 1
Next objSubFolder
handleCancel:
If Err = 18 Then
MsgBox "Ai anulat procesul inainte de finalizare! Reia procedura!"
nuexistafolderul:
MsgBox "Nu exista folderul pentru extractia contractelor! Extrage intai contractele!"
End If
'CALLS A MODULE THAT INSERTS CERTAIN TEXT INTO A BATCH FILE
Call Module1.batchfile2
End Sub