To pick a path, & fallback to the source file's folder (if nothing is chosen), you could change:
StrPth = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), "\"))
to:
StrPth = GetFolder & "\"
If StrPth = "\" Then StrPth = Left(.SelectedItems(1), InStrRev(.SelectedItems(1), "\"))
and add the following function to the code module:
Code:
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function