[AccessD] Code to get a directory name via navigation

Arthur,

Here's a modified version if something I downloaded from PlanetSourceCode a
while back, it allows you to specify the initial folder that's selected and
you can specify the text that appears for the user.

Chris Mackin
Denver Database Consulting, LLC
www.denverdb.com

'*******************************
Option Compare Database
Option Explicit

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function SHBrowseForFolder Lib _
"shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib _
"shell32" (ByVal pidList As Long, ByVal lpBuffer _
As String) As Long

'Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, ByVal _
lpString2 As String) As Long

Private Type BrowseInfo
   hWndOwner As Long
   pidlRoot As Long
   pszDisplayName As Long
   strTitle As String
   ulFlags As Long
   lpfnCallback As Long
   lParam As Long
   iImage As Long
End Type

Public Const LMEM_FIXED = &H0   'added
Public Const LMEM_ZEROINIT = &H40   'added
Public Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)   'added

Public Declare Function LocalAlloc Lib "kernel32" _
 (ByVal uFlags As Long, _
    ByVal uBytes As Long) As Long   'added

Public Declare Function LocalFree Lib "kernel32" _
  (ByVal hMem As Long) As Long  'added

Public Declare Function lstrcpyA Lib "kernel32" _
  (lpString1 As Any, lpString2 As Any) As Long  'added

Public Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long   'added

Public Declare Sub CopyMemory Lib "kernel32" _
    Alias "RtlMoveMemory" _
   (pDest As Any, _
    pSource As Any, _
    ByVal dwLength As Long) 'added

Public Const BFFM_INITIALIZED = 1   'added
Public Const WM_USER = &H400    'added

'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED
'message.
Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)

Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
   ByVal wParam As Long, lParam As Any) As Long

Public Function GetFolder(strPath As String, Optional strTitle As String =
"Select Folder") As String
Dim lpIDList As Long
Dim sBuffer As String
Dim szTitle As String
Dim lpPath As Long
Dim tBrowseInfo As BrowseInfo

With tBrowseInfo
   .hWndOwner = Application.hWndAccessApp
   .pidlRoot = 0
   .strTitle = strTitle
   .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
   .lpfnCallback = FARPROC(AddressOf BrowseCallbackProcStr)
    lpPath = LocalAlloc(LPTR, Len(strPath) + 1)
    CopyMemory ByVal lpPath, ByVal strPath, Len(strPath) + 1
    .lParam = lpPath
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)

If (lpIDList) Then
   sBuffer = Space(MAX_PATH)
   SHGetPathFromIDList lpIDList, sBuffer
   sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If

GetFolder = sBuffer

End Function

Private Function BrowseCallbackProcStr(ByVal hWnd As Long, _
                                      ByVal uMsg As Long, _
                                      ByVal lParam As Long, _
                                      ByVal lpData As Long) As Long

  'Callback for the Browse STRING method.

  'On initialization, set the dialog's
  'pre-selected folder from the pointer
  'to the path allocated as bi.lParam,
  'passed back to the callback as lpData param.
   Select Case uMsg
      Case BFFM_INITIALIZED
         Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal lpData)
         Case Else
   End Select

End Function

Private Function FARPROC(pfn As Long) As Long
  '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 (as returned here)
  FARPROC = pfn
End Function
'*************************************************




-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Arthur Fuller
Sent: Saturday, March 29, 2003 8:16 AM
To: accessd at databaseadvisors.com
Subject: [AccessD] Code to get a directory name via navigation


I have the ADH code that lets you pick a filename by nivagating to it, but
it seems none of the args lets you request a directory name instead of a
filename. Anyone have code to do this? (Or if it's elsewhere in ADH I just
have to find it.)

TIA,
Arthur

_______________________________________________
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com