If you wanna have a default path for the folder dialog use:Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Sub CoTaskMemFree Lib "ole32" (ByVal pv As Long)
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Public Const WM_USER = &H400
Public Const BFFM_INITIALIZED = 1
Public Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Public Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
Public Const BFFM_ENABLEOK As Long = (WM_USER + 101)
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Public Const LMEM_FIXED = &H0
Public Const LMEM_ZEROINIT = &H40
Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
Public Const MAX_PATH = 2600
Public 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
'
' - Function MeBrowseForFolderByPath
' Description:
' Opens the folder dialog with a default path.
' Arguments:
' - DefPth = Default path
' - DlgTit = Dialog title
' Returns:
' - Path
' - "" on cancel or error
' Exceptions:
' - None
' Notes:
' - Based on 'Pre-selecting a Folder using the Browse Callback'
' by Randy Birch, VBnet
' Copyright ©1996-2004 VBnet, Randy Birch, All Rights Reserved.
'
Public Function MeBrowseForFolderByPath(ByVal DefPth As String, ByVal DlgTit As String) As String
Dim BrwInf As BROWSEINFO
Dim FoPidl As Long
Dim SelPth As Long
Dim RetVal As String * MAX_PATH
With BrwInf
.hOwner = ThisDrawing.hWnd
.pidlRoot = 0
.lpszTitle = DlgTit
.lpfn = MeFarProc(AddressOf MeBrowseCallbackProcStr)
SelPth = LocalAlloc(LPTR, Len(DefPth) + 1)
CopyMemory ByVal SelPth, ByVal DefPth, Len(DefPth) + 1
.lParam = SelPth
End With
FoPidl = SHBrowseForFolder(BrwInf)
If FoPidl Then
If SHGetPathFromIDList(FoPidl, RetVal) Then
MeBrowseForFolderByPath = MeCutNulls(RetVal)
Else
MeBrowseForFolderByPath = ""
End If
Call CoTaskMemFree(FoPidl)
Else
MeBrowseForFolderByPath = ""
End If
Call LocalFree(SelPth)
End Function
'
' Callback for the Browse STRING method.
' On initialization, set the dialog's
' pre-selected folder from the pointer
' to the path allocated as BrwInf.lParam,
' passed back to the callback as lpData param.
'
Public Function MeBrowseCallbackProcStr(ByVal CurHdl As Long, ByVal UsrMsg As Long, ByVal TmpPrm As Long, _
ByVal CurDat As Long) As Long
Select Case UsrMsg
Case BFFM_INITIALIZED
Call SendMessage(CurHdl, BFFM_SETSELECTIONA, True, ByVal CurDat)
Case Else:
End Select
End Function
'
' A dummy procedure that receives and returns
' the value of the AddressOf operator.
' This workaround is needed as you can't
' assign AddressOf directly to a member of a
' user-defined type, but you can assign it
' to another long and use that instead!
'
Public Function MeFarProc(AdrVal As Long) As Long
MeFarProc = AdrVal
End Function
'
' Removes 'Nulls' in a string.
'
Public Function MeCutNulls(ByVal StrNul As String) As String
MeCutNulls = Left$(StrNul, InStr(StrNul, Chr$(0)) - 1)
End Function
Cheers