Private Function GetFileDir() As String

Const PROCNAME As String = "GetFileDir"

On Error GoTo ErrorHandler

Dim ret As String
Dim lpIDList As Long
Dim spath As String
Dim udtBI As BROWSEINFO
Dim RdStrings() As String
Dim nNewFiles As Long

'Show a browse-for-folder form:
With udtBI
.lpszTitle = lstrcpyA(EXM_016, "")
.ulFlags = BFFM_INITIALIZED
End With

lpIDList = SHBrowseForFolder(udtBI)
If lpIDList = 0 Then Exit Function

'Get the selected folder.
spath = String$(MAX_PATH, 0)
SHGetPathFromIDList lpIDList, spath 'Hier stürzt Outlook ab
CoTaskMemFree lpIDList

'Strip Nulls
If (InStr(spath, Chr$(0)) > 0) Then spath = Left$(spath, InStr(spath, Chr(0)) - 1)

'Return Dir
GetFileDir = spath