Function FoldPick(Optional InitialDir As String = "") As String
Dim FD As FileDialog
FoldPick = ""
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
FD.InitialFileName = InitialDir
If FD.Show <> 0 Then
FoldPick = FD.SelectedItems(1)
End If
End Function