I've decided to use this code:
This gives you the ability to create a directory select is.
Works fine for me!
'http://www.microsoft.com/technet/scriptcenter/resources/qanda/jun05/hey0617.mspx
'You must set a reference to the Microsoft Scripting Runtime
'to use the BrowseFolder_Scripting() function in your application!
'One of the advantages of this function is it gives the user the
'option to create a new folder and you can set [which also limits] where
'the user can browse from. The API function does not.
Public Function BrowseFolder_Scripting(StrDefPath As String) As String
On Error GoTo Err_BrowseFolder_Scripting
Dim objShell As Object
Dim objfolder As Object
Dim objFolderItem As Object
Dim sBrowsingPath As String
Dim Wscript As Object
Dim sPath As String
Dim test As String
Const MY_COMPUTER = &H11&
Const WINDOW_HANDLE = 0
Const OPTIONS = 0
StartUp
Set objShell = CreateObject("Shell.Application")
Rem Set objfolder = objShell.NameSpace(MY_COMPUTER)
Rem Set objFolderItem = objfolder.Self
Rem sBrowsingPath = objFolderItem.Path
sBrowsingPath = strDefaultFolder
Set objShell = CreateObject("Shell.Application")
Set objfolder = objShell.BrowseForFolder _
(WINDOW_HANDLE, "Select a folder for exporting your file:", OPTIONS, "C:\Users\mvane_000\OneDrive\CAE\00_CAE\_Opdrachten\_2016")
'Switch the above line with the next line if you want to limit the user to browsing only their C:\ drive
'(WINDOW_HANDLE, "Select a folder for exporting your file:", OPTIONS, "C:\")
If objfolder Is Nothing Then
Wscript.Quit
End If
Set objFolderItem = objfolder.Self
sPath = objFolderItem.path
If Right(sPath, 1) <> "\" Then
sPath = sPath & "\"
End If
BrowseFolder_Scripting = sPath
Exit_BrowseFolder_Scripting:
Exit Function
Err_BrowseFolder_Scripting:
If Err.Number = 91 Then 'Object variable or With block variable not set
MsgBox "User did not select a valid folder.", vbInformation, "Folder Selection Canceled"
Exit Function
ElseIf Err.Number = 424 Then
MsgBox "User did not select a valid folder.", vbInformation, "Folder Selection Canceled"
Exit Function
Else
MsgBox Err.Number & " - " & Err.Description
Resume Exit_BrowseFolder_Scripting
End If
End Function
'Run this function as-is to test the BrowseFolder_Scripting()function
Public Function Test_BrowseFolder_Scripting()
On Error GoTo Err_Test_BrowseFolder_Scripting
Dim sFolderName As String
sFolderName = BrowseFolder_Scripting
If sFolderName <> "" Then MsgBox "You selected the '" & sFolderName & "' folder.", vbInformation
Exit_Test_BrowseFolder_Scripting:
Exit Function
Err_Test_BrowseFolder_Scripting:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Test_BrowseFolder_Scripting
End Function