Sometimes we need to choose a folder during our process of development, but special function for this I did not found. Very often we need to choose only folder (for example for saving attaches from documents)
To solve this task we can use Win API 's methods. Here you will see an example of it.
(Declarations)
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_DONTGOBELOWDOMAIN = 2
Const MAX_PATH = 260
Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpbi As BrowseInfo ) As Long
Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" ( Byval pidList As Long, Byval lpBuffer As String ) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( Byval lpClassName As Any, Byval lpWindowName As Any ) As Long
Main functionFunction ChooseFolder ( dialogPrompt As String ) As String
Dim lpIDList As Long
Dim sBuffer As String * 255
Dim sReturnVal As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
sBuffer = String ( Len ( sBuffer ) , Chr(0) )
szTitle = dialogPrompt
tBrowseInfo.hWndOwner = FindWindow ( "notes", &H0 )
tBrowseInfo.lpszTitle = szTitle
tBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
lpIDList = SHBrowseForFolder ( tBrowseInfo )
If ( lpIDList ) Then
SHGetPathFromIDList lpIDList, sBuffer
ChooseFolder = Left ( sBuffer, Instr ( sBuffer, Chr(0) ) - 1)
End If
End Function
Here is the code on button
Sub Click(Source As Button)
Dim w As New NotesUIWorkspace
Dim doc As NotesDocument
Dim folder As String
Set doc = w.CurrentDocument.Document
folder = ChooseFolder("Select directory")
If folder<>"" Then
Call doc.ReplaceItemValue("FolderPath", folder)
Call w.CurrentDocument.Refresh
End If
End Sub
2 comments :
Hi, Dmytro! :)
Try this method, it is simple, not so beautiful like yours one, but it works too! :)
There is one tip, if user types some in "Dyrectory" it will be included in the result path, so you have to check the path returned...
sorry for my english ;)
Function SelectPath(OutPath As String) As Boolean
Dim ws As New NotesUIWorkspace
Dim path As Variant
path = ws.SaveFileDialog(True, "Select folder...")
If Isempty(path) Then
OutPath = ""
SelectPath = False
Else
OutPath = path(0)
SelectPath = True
End If
End Function
Real heroes always looking for another way :-)...
Post a Comment