Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_DONTGOBELOWDOMAIN = &H2
Const BIF_STATUSTEXT = &H4
Const BIF_RETURNFSANCESTORS = &H8
Const BIF_BROWSEFORCOMPUTER = &H1000
Const BIF_BROWSEFORPRINTER = &H2000
Const MAX_PATH = 260
Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA"
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA"
(lpBrowseInfo As BROWSEINFO) As Long
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Declare Function GetDesktopWindow Lib "user32" () As Long
Sub Initialize()
Dim session As New NotesSession
Dim db As NotesDatabase
Dim collection As NotesDocumentCollection
Dim doc As NotesDocument
Dim rtitem As Variant
Dim NotesItem As NotesItem
Dim bi As BROWSEINFO
Dim pidl As Long
Dim path As String
Dim pos As Integer
bi.hOwner = GetDesktopWindow()
bi.pidlRoot = 0&
bi.lpszTitle = "Select directory to save the attachments"
bi.ulFlags = BIF_RETURNONLYFSDIRS
pidl = SHBrowseForFolder(bi)
path = Space$(MAX_PATH)
If SHGetPathFromIDList(ByVal pidl, ByVal path) Then
pos = InStr(path, Chr$(0))
End If