I am using this code to browse for a folder (just folders no files) in
Access 2007.
It works great, I just want one extra feature:
- to supply a starting folder

I found one example on stephen lebans site
http://www.lebans.com/callbackbrowser.htm
but it required the code to exist in the code behind the form.
I use this on about 10 forms so would prefer something that I could place in
just one module.

Does anyone have a better solution?
Thanks in advance,
Mark

--------------------------------
Option Compare Database
Option Explicit

Private 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

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
As Long

Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_NEWDIALOGSTYLE = &H40

Public Function BrowseFolder(szDialogTitle As String) As String
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer

With bi
.hOwner = hWndAccessApp
.lpszTitle = szDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
wPos = InStr(szPath, Chr(0))
BrowseFolder = Left$(szPath, wPos - 1)
Else
BrowseFolder = vbNullString
End If
End Function
----------------------------------------

Try this, which is where the original code that Stephen used came from:

http://www.mvps.org/access/api/api0002.htm
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.accessmvp.com
http://www.mvps.org/access


"Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
news:(E-Mail Removed)...
>I am using this code to browse for a folder (just folders no files) in
> Access 2007.
> It works great, I just want one extra feature:
> - to supply a starting folder
>
> I found one example on stephen lebans site
> http://www.lebans.com/callbackbrowser.htm
> but it required the code to exist in the code behind the form.
> I use this on about 10 forms so would prefer something that I could place
> in
> just one module.
>
> Does anyone have a better solution?
> Thanks in advance,
> Mark
>
> --------------------------------
> Option Compare Database
> Option Explicit
>
> Private 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
>
> Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
> "SHGetPathFromIDListA" (ByVal pidl As Long, _
> ByVal pszPath As String) As Long
>
> Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
> "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
> As Long
>
> Private Const BIF_RETURNONLYFSDIRS = &H1
> Private Const BIF_NEWDIALOGSTYLE = &H40
>
> Public Function BrowseFolder(szDialogTitle As String) As String
> Dim X As Long, bi As BROWSEINFO, dwIList As Long
> Dim szPath As String, wPos As Integer
>
> With bi
> .hOwner = hWndAccessApp
> .lpszTitle = szDialogTitle
> .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
> End With
>
> dwIList = SHBrowseForFolder(bi)
> szPath = Space$(512)
> X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
>
> If X Then
> wPos = InStr(szPath, Chr(0))
> BrowseFolder = Left$(szPath, wPos - 1)
> Else
> BrowseFolder = vbNullString
> End If
> End Function
> ----------------------------------------
>
>

"Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
news:(E-Mail Removed)...
>I am using this code to browse for a folder (just folders no files) in
> Access 2007.
> It works great, I just want one extra feature:
> - to supply a starting folder
>
> I found one example on stephen lebans site
> http://www.lebans.com/callbackbrowser.htm
> but it required the code to exist in the code behind the form.
> I use this on about 10 forms so would prefer something that I could place
> in
> just one module.

Put it this way. If Stephen couldn't make it work with the code in a single
common module, it can't be done.

--
Doug Steele, Microsoft Access MVP
http://I.Am/DougSteele
(no private e-mails, please)

Hi Mark
I have been using this function for a long time. Think it did start from
someone else but I have tweaked it over the years. Basically you pass the
form name and an optional starting path. It will return the file name. You
will have to tweak it to only return the folder, but that should not be too
hard.

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Hope this helps

'---------------------------------------------------------------------------------------
' Procedure : funBrowse
' Author : Neville Turbit
' Date : 04/06/09
' Purpose : Function to search all files
'---------------------------------------------------------------------------------------
'
Function funBrowse(strform As Form, Optional strPath As String) As String

On Error GoTo Error_funBrowse

Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String

OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = strform.hWnd

' Don't filter the files
sFilter = "All Files (*.*)" & Chr(0) & "*.*" '& Chr(0) & _
"JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1

OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile

' Set the initial directory
If IsNull(strPath) Then
OpenFile.lpstrInitialDir = "C:\"
Else
OpenFile.lpstrInitialDir = strPath
End If

OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
OpenFile.flags = 0

lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
MsgBox "A file was not selected!", vbInformation, _
"Select a file using the Common Dialog DLL"
Else
funBrowse = Trim(Left(OpenFile.lpstrFile, InStr(1,
OpenFile.lpstrFile, vbNullChar) - 1))
End If

Exit_funBrowse:
On Error GoTo 0
Exit Function

Error_funBrowse:

MsgBox "An unexpected situation arose in your program." & funCrLf & _
"Please write down the following details:" & funCrLf & funCrLf & _
"Module Name: modGeneric" & funCrLf & _
"Type: Module" & funCrLf & _
"Calling Procedure: funBrowse" & funCrLf & _
"Error Number: " & Err.Number & funCrLf & _
"Error Descritption: " & Err.Description

Resume Exit_funBrowse
End Function



"Douglas J. Steele" wrote:

> "Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
> news:(E-Mail Removed)...
> >I am using this code to browse for a folder (just folders no files) in
> > Access 2007.
> > It works great, I just want one extra feature:
> > - to supply a starting folder
> >
> > I found one example on stephen lebans site
> > http://www.lebans.com/callbackbrowser.htm
> > but it required the code to exist in the code behind the form.
> > I use this on about 10 forms so would prefer something that I could place
> > in
> > just one module.
>
> Put it this way. If Stephen couldn't make it work with the code in a single
> common module, it can't be done.
>
> --
> Doug Steele, Microsoft Access MVP
> http://I.Am/DougSteele
> (no private e-mails, please)
>
>
>
> .
>

Ooops. Put the text "hope this helps" in the wrong place. Sorry.

"NevilleT" wrote:

> Hi Mark
> I have been using this function for a long time. Think it did start from
> someone else but I have tweaked it over the years. Basically you pass the
> form name and an optional starting path. It will return the file name. You
> will have to tweak it to only return the folder, but that should not be too
> hard.
>
> Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
> "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
>
> Private Type OPENFILENAME
> lStructSize As Long
> hwndOwner As Long
> hInstance As Long
> lpstrFilter As String
> lpstrCustomFilter As String
> nMaxCustFilter As Long
> nFilterIndex As Long
> lpstrFile As String
> nMaxFile As Long
> lpstrFileTitle As String
> nMaxFileTitle As Long
> lpstrInitialDir As String
> lpstrTitle As String
> flags As Long
> nFileOffset As Integer
> nFileExtension As Integer
> lpstrDefExt As String
> lCustData As Long
> lpfnHook As Long
> lpTemplateName As String
> End Type
>
> Hope this helps
>
> '---------------------------------------------------------------------------------------
> ' Procedure : funBrowse
> ' Author : Neville Turbit
> ' Date : 04/06/09
> ' Purpose : Function to search all files.
> '---------------------------------------------------------------------------------------
> '
> Function funBrowse(strform As Form, Optional strPath As String) As String
>
> On Error GoTo Error_funBrowse
>
> Dim OpenFile As OPENFILENAME
> Dim lReturn As Long
> Dim sFilter As String
>
> OpenFile.lStructSize = Len(OpenFile)
> OpenFile.hwndOwner = strform.hWnd
>
> ' Don't filter the files
> sFilter = "All Files (*.*)" & Chr(0) & "*.*" '& Chr(0) & _
> "JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
> OpenFile.lpstrFilter = sFilter
> OpenFile.nFilterIndex = 1
>
> OpenFile.lpstrFile = String(257, 0)
> OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
> OpenFile.lpstrFileTitle = OpenFile.lpstrFile
> OpenFile.nMaxFileTitle = OpenFile.nMaxFile
>
> ' Set the initial directory
> If IsNull(strPath) Then
> OpenFile.lpstrInitialDir = "C:\"
> Else
> OpenFile.lpstrInitialDir = strPath
> End If
>
> OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
> OpenFile.flags = 0
>
> lReturn = GetOpenFileName(OpenFile)
> If lReturn = 0 Then
> MsgBox "A file was not selected!", vbInformation, _
> "Select a file using the Common Dialog DLL"
> Else
> funBrowse = Trim(Left(OpenFile.lpstrFile, InStr(1,
> OpenFile.lpstrFile, vbNullChar) - 1))
> End If
>
> Exit_funBrowse:
> On Error GoTo 0
> Exit Function
>
> Error_funBrowse:
>
> MsgBox "An unexpected situation arose in your program." & funCrLf & _
> "Please write down the following details:" & funCrLf & funCrLf & _
> "Module Name: modGeneric" & funCrLf & _
> "Type: Module" & funCrLf & _
> "Calling Procedure: funBrowse" & funCrLf & _
> "Error Number: " & Err.Number & funCrLf & _
> "Error Descritption: " & Err.Description
>
> Resume Exit_funBrowse
> End Function
>
>
>
> "Douglas J. Steele" wrote:
>
> > "Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
> > news:(E-Mail Removed)...
> > >I am using this code to browse for a folder (just folders no files) in
> > > Access 2007.
> > > It works great, I just want one extra feature:
> > > - to supply a starting folder
> > >
> > > I found one example on stephen lebans site
> > > http://www.lebans.com/callbackbrowser.htm
> > > but it required the code to exist in the code behind the form.
> > > I use this on about 10 forms so would prefer something that I could place
> > > in
> > > just one module.
> >
> > Put it this way. If Stephen couldn't make it work with the code in a single
> > common module, it can't be done.
> >
> > --
> > Doug Steele, Microsoft Access MVP
> > http://I.Am/DougSteele
> > (no private e-mails, please)
> >
> >
> >
> > .
> >

Thanks, however that's what I am using right now.
Mark

"Arvin Meyer [MVP]" <(E-Mail Removed)> wrote in message
news:#(E-Mail Removed)...
> Try this, which is where the original code that Stephen used came from:
>
> http://www.mvps.org/access/api/api0002.htm
> --
> Arvin Meyer, MCP, MVP
> http://www.datastrat.com
> http://www.accessmvp.com
> http://www.mvps.org/access
>
>
> "Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
> news:(E-Mail Removed)...
>>I am using this code to browse for a folder (just folders no files) in
>> Access 2007.
>> It works great, I just want one extra feature:
>> - to supply a starting folder
>>
>> I found one example on stephen lebans site
>> http://www.lebans.com/callbackbrowser.htm
>> but it required the code to exist in the code behind the form.
>> I use this on about 10 forms so would prefer something that I could place
>> in
>> just one module.
>>
>> Does anyone have a better solution?
>> Thanks in advance,
>> Mark
>>
>> --------------------------------
>> Option Compare Database
>> Option Explicit
>>
>> Private 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
>>
>> Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
>> "SHGetPathFromIDListA" (ByVal pidl As Long, _
>> ByVal pszPath As String) As Long
>>
>> Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
>> "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>> As Long
>>
>> Private Const BIF_RETURNONLYFSDIRS = &H1
>> Private Const BIF_NEWDIALOGSTYLE = &H40
>>
>> Public Function BrowseFolder(szDialogTitle As String) As String
>> Dim X As Long, bi As BROWSEINFO, dwIList As Long
>> Dim szPath As String, wPos As Integer
>>
>> With bi
>> .hOwner = hWndAccessApp
>> .lpszTitle = szDialogTitle
>> .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
>> End With
>>
>> dwIList = SHBrowseForFolder(bi)
>> szPath = Space$(512)
>> X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
>>
>> If X Then
>> wPos = InStr(szPath, Chr(0))
>> BrowseFolder = Left$(szPath, wPos - 1)
>> Else
>> BrowseFolder = vbNullString
>> End If
>> End Function
>> ----------------------------------------
>>
>>
>
>

Yea I think you are right.
Mark

"Douglas J. Steele" <NOSPAM_djsteele@NOSPAM_gmail.com> wrote in message
news:(E-Mail Removed)...
> "Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
> news:(E-Mail Removed)...
>>I am using this code to browse for a folder (just folders no files) in
>> Access 2007.
>> It works great, I just want one extra feature:
>> - to supply a starting folder
>>
>> I found one example on stephen lebans site
>> http://www.lebans.com/callbackbrowser.htm
>> but it required the code to exist in the code behind the form.
>> I use this on about 10 forms so would prefer something that I could place
>> in
>> just one module.
>
> Put it this way. If Stephen couldn't make it work with the code in a
> single common module, it can't be done.
>
> --
> Doug Steele, Microsoft Access MVP
> http://I.Am/DougSteele
> (no private e-mails, please)
>
>
>

Thanks, however this is not quite what I want.
Mark

"NevilleT" <(E-Mail Removed)> wrote in message
news:466F577E-3EBE-4FD5-B467-(E-Mail Removed)...
> Hi Mark
> I have been using this function for a long time. Think it did start from
> someone else but I have tweaked it over the years. Basically you pass the
> form name and an optional starting path. It will return the file name.
> You
> will have to tweak it to only return the folder, but that should not be
> too
> hard.
>
> Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
> "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
>
> Private Type OPENFILENAME
> lStructSize As Long
> hwndOwner As Long
> hInstance As Long
> lpstrFilter As String
> lpstrCustomFilter As String
> nMaxCustFilter As Long
> nFilterIndex As Long
> lpstrFile As String
> nMaxFile As Long
> lpstrFileTitle As String
> nMaxFileTitle As Long
> lpstrInitialDir As String
> lpstrTitle As String
> flags As Long
> nFileOffset As Integer
> nFileExtension As Integer
> lpstrDefExt As String
> lCustData As Long
> lpfnHook As Long
> lpTemplateName As String
> End Type
>
> Hope this helps
>
> '---------------------------------------------------------------------------------------
> ' Procedure : funBrowse
> ' Author : Neville Turbit
> ' Date : 04/06/09
> ' Purpose : Function to search all files.
> '---------------------------------------------------------------------------------------
> '
> Function funBrowse(strform As Form, Optional strPath As String) As String
>
> On Error GoTo Error_funBrowse
>
> Dim OpenFile As OPENFILENAME
> Dim lReturn As Long
> Dim sFilter As String
>
> OpenFile.lStructSize = Len(OpenFile)
> OpenFile.hwndOwner = strform.hWnd
>
> ' Don't filter the files
> sFilter = "All Files (*.*)" & Chr(0) & "*.*" '& Chr(0) & _
> "JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
> OpenFile.lpstrFilter = sFilter
> OpenFile.nFilterIndex = 1
>
> OpenFile.lpstrFile = String(257, 0)
> OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
> OpenFile.lpstrFileTitle = OpenFile.lpstrFile
> OpenFile.nMaxFileTitle = OpenFile.nMaxFile
>
> ' Set the initial directory
> If IsNull(strPath) Then
> OpenFile.lpstrInitialDir = "C:\"
> Else
> OpenFile.lpstrInitialDir = strPath
> End If
>
> OpenFile.lpstrTitle = "Select a file using the Common Dialog DLL"
> OpenFile.flags = 0
>
> lReturn = GetOpenFileName(OpenFile)
> If lReturn = 0 Then
> MsgBox "A file was not selected!", vbInformation, _
> "Select a file using the Common Dialog DLL"
> Else
> funBrowse = Trim(Left(OpenFile.lpstrFile, InStr(1,
> OpenFile.lpstrFile, vbNullChar) - 1))
> End If
>
> Exit_funBrowse:
> On Error GoTo 0
> Exit Function
>
> Error_funBrowse:
>
> MsgBox "An unexpected situation arose in your program." & funCrLf & _
> "Please write down the following details:" & funCrLf & funCrLf &
> _
> "Module Name: modGeneric" & funCrLf & _
> "Type: Module" & funCrLf & _
> "Calling Procedure: funBrowse" & funCrLf & _
> "Error Number: " & Err.Number & funCrLf & _
> "Error Descritption: " & Err.Description
>
> Resume Exit_funBrowse
> End Function
>
>
>
> "Douglas J. Steele" wrote:
>
>> "Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
>> news:(E-Mail Removed)...
>> >I am using this code to browse for a folder (just folders no files) in
>> > Access 2007.
>> > It works great, I just want one extra feature:
>> > - to supply a starting folder
>> >
>> > I found one example on stephen lebans site
>> > http://www.lebans.com/callbackbrowser.htm
>> > but it required the code to exist in the code behind the form.
>> > I use this on about 10 forms so would prefer something that I could
>> > place
>> > in
>> > just one module.
>>
>> Put it this way. If Stephen couldn't make it work with the code in a
>> single
>> common module, it can't be done.
>>
>> --
>> Doug Steele, Microsoft Access MVP
>> http://I.Am/DougSteele
>> (no private e-mails, please)
>>
>>
>>
>> .
>>

You added a bit:

Private Const BIF_NEWDIALOGSTYLE = &H40
and
..ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.accessmvp.com
http://www.mvps.org/access


"Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
news:%234gA%(E-Mail Removed)...
> Thanks, however that's what I am using right now.
> Mark

> "Arvin Meyer [MVP]" <(E-Mail Removed)> wrote in message
> news:#(E-Mail Removed)...
>> Try this, which is where the original code that Stephen used came from:
>>
>> http://www.mvps.org/access/api/api0002.htm
>> --
>> Arvin Meyer, MCP, MVP
>> http://www.datastrat.com
>> http://www.accessmvp.com
>> http://www.mvps.org/access
>>
>>
>> "Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
>> news:(E-Mail Removed)...
>>>I am using this code to browse for a folder (just folders no files) in
>>> Access 2007.
>>> It works great, I just want one extra feature:
>>> - to supply a starting folder
>>>
>>> I found one example on stephen lebans site
>>> http://www.lebans.com/callbackbrowser.htm
>>> but it required the code to exist in the code behind the form.
>>> I use this on about 10 forms so would prefer something that I could
>>> place in
>>> just one module.
>>>
>>> Does anyone have a better solution?
>>> Thanks in advance,
>>> Mark
>>>
>>> --------------------------------
>>> Option Compare Database
>>> Option Explicit
>>>
>>> Private 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
>>>
>>> Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
>>> "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>> ByVal pszPath As String) As Long
>>>
>>> Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
>>> "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>> As Long
>>>
>>> Private Const BIF_RETURNONLYFSDIRS = &H1
>>> Private Const BIF_NEWDIALOGSTYLE = &H40
>>>
>>> Public Function BrowseFolder(szDialogTitle As String) As String
>>> Dim X As Long, bi As BROWSEINFO, dwIList As Long
>>> Dim szPath As String, wPos As Integer
>>>
>>> With bi
>>> .hOwner = hWndAccessApp
>>> .lpszTitle = szDialogTitle
>>> .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
>>> End With
>>>
>>> dwIList = SHBrowseForFolder(bi)
>>> szPath = Space$(512)
>>> X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
>>>
>>> If X Then
>>> wPos = InStr(szPath, Chr(0))
>>> BrowseFolder = Left$(szPath, wPos - 1)
>>> Else
>>> BrowseFolder = vbNullString
>>> End If
>>> End Function
>>> ----------------------------------------
>>>
>>>
>>
>>

"Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
news:%234gA%(E-Mail Removed)...
> Thanks, however that's what I am using right now.
> Mark
>
> "Arvin Meyer [MVP]" <(E-Mail Removed)> wrote in message
> news:#(E-Mail Removed)...
>> Try this, which is where the original code that Stephen used came from:
>>
>> http://www.mvps.org/access/api/api0002.htm
>> --
>> Arvin Meyer, MCP, MVP
>> http://www.datastrat.com
>> http://www.accessmvp.com
>> http://www.mvps.org/access
>>
>>
>> "Mark Andrews" <mandrews___NOSPAM___@rptsoftware.com> wrote in message
>> news:(E-Mail Removed)...
>>>I am using this code to browse for a folder (just folders no files) in
>>> Access 2007.
>>> It works great, I just want one extra feature:
>>> - to supply a starting folder
>>>
>>> I found one example on stephen lebans site
>>> http://www.lebans.com/callbackbrowser.htm
>>> but it required the code to exist in the code behind the form.
>>> I use this on about 10 forms so would prefer something that I could
>>> place in
>>> just one module.
>>>
>>> Does anyone have a better solution?
>>> Thanks in advance,
>>> Mark
>>>
>>> --------------------------------
>>> Option Compare Database
>>> Option Explicit
>>>
>>> Private 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
>>>
>>> Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
>>> "SHGetPathFromIDListA" (ByVal pidl As Long, _
>>> ByVal pszPath As String) As Long
>>>
>>> Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
>>> "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) _
>>> As Long
>>>
>>> Private Const BIF_RETURNONLYFSDIRS = &H1
>>> Private Const BIF_NEWDIALOGSTYLE = &H40
>>>
>>> Public Function BrowseFolder(szDialogTitle As String) As String
>>> Dim X As Long, bi As BROWSEINFO, dwIList As Long
>>> Dim szPath As String, wPos As Integer
>>>
>>> With bi
>>> .hOwner = hWndAccessApp
>>> .lpszTitle = szDialogTitle
>>> .ulFlags = BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE
>>> End With
>>>
>>> dwIList = SHBrowseForFolder(bi)
>>> szPath = Space$(512)
>>> X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
>>>
>>> If X Then
>>> wPos = InStr(szPath, Chr(0))
>>> BrowseFolder = Left$(szPath, wPos - 1)
>>> Else
>>> BrowseFolder = vbNullString
>>> End If
>>> End Function
>>> ----------------------------------------

Hi Mark

Unfortunately the browse folder dialog code wasn't written with VBA in mind.
You have to use a callback function in order to get the dialog to display
the initial folder selection. If anything causes VBA to go into break mode
while this is executing, Access will probably crash. That said, here is the
code you need. Create a class module (call it clsBrowseFolder) and paste in
the following:

''' Start Code '''
Option Compare Database
Option Explicit
'
Private 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
'
Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolderA Lib "shell32.dll" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(pDest As Any, pSource As Any, ByVal dwLength As Long)

Private Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Const LPTR = (&H0 Or &H40)
'
Private m_Caption As String
Private m_InitDir As String
Private m_ReturnDir As String
Private m_UserCancel As Boolean
Private m_hWndOwner As Long
Private m_ErrOption As Long

Public Property Get Caption() As String
Caption = m_Caption
End Property
Public Property Let Caption(NewData As String)
If Len(NewData) > 50 Then
Err.Raise vbObjectError + 1, _
"clsFolderDialog.Caption", _
"Caption too long. 50 chars max."
End If
m_Caption = NewData
End Property

Public Property Let InitDir(NewData As String)
m_InitDir = NewData
End Property

Public Property Get ReturnDir() As String
ReturnDir = m_ReturnDir
End Property

Public Property Get UserCancel() As Boolean
UserCancel = m_UserCancel
End Property

Public Property Let hWndOwner(NewData As Long)
m_hWndOwner = NewData
End Property

Public Sub Execute()
Dim bi As BROWSEINFO
Dim Buffer As String
Dim PathPtr As Long
Dim itemID As Long
'
With bi
.hOwner = m_hWndOwner
.ulFlags = 1
.lpszTitle = m_Caption
.lpfn = FuncPtr(AddressOf BrowseFolderHookProc)
PathPtr = LocalAlloc(LPTR, Len(m_InitDir) + 1)
CopyMemory ByVal PathPtr, ByVal m_InitDir, Len(m_InitDir) + 1
.lParam = PathPtr
End With
Buffer = Space$(512)
itemID = SHBrowseForFolderA(bi)
If SHGetPathFromIDListA(itemID, Buffer) Then
m_ReturnDir = Left(Buffer, InStr(Buffer, vbNullChar) - 1)
Else
m_UserCancel = True
End If
CoTaskMemFree itemID
LocalFree PathPtr
End Sub

Private Sub Class_Initialize()
m_Caption = "Please Select Folder"
With Application
m_hWndOwner = .hWndAccessApp
m_ErrOption = .GetOption("Error Trapping")
.SetOption "Error Trapping", 2
End With
End Sub

Private Sub Class_Terminate()
On Error Resume Next
Application.SetOption "Error Trapping", m_ErrOption
End Sub

Private Function FuncPtr(pFunc As Long) As Long
FuncPtr = pFunc
End Function
''' End Code '''

Then create a standard module (call it modBrowseFolder) and paste in the
following:

''' Start Code '''
Option Compare Database
Option Explicit
'
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
'
Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)

Public Function BrowseFolderHookProc(ByVal hWnd As Long, ByVal uMsg As Long,
_
ByVal lParam As Long, ByVal lpData As Long) As Long
If uMsg = 1 Then
Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal lpData)
End If
End Function
''' End Code '''

A simple test:

With New clsBrowseFolder
.hwndOwner = Application.hWndAccessApp
.InitDir = "c:\temp"
.Execute
If Not .UserCancel Then
MsgBox "Selected Folder: " & .ReturnDir
End If
End With

Hope that helps.