choosing folder in vba-access

Hi All

i'm trying to build a parallel function in vba access that appear in
excel:

FileDialog(msoFileDialogFolderPicker)

does anyone know how to choose only a folder through VBA in Access?

Re: choosing folder in vba-access

Past this in somewhere. I know it's a bit of a mouthful and I know there are
easier routines, but it works

Phil

Option Compare Database
Option Explicit

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OpenFilename) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OpenFilename) As Boolean

Type MSA_OPENFILENAME
' Filter string used for the Open dialog filters.
' Use MSA_CreateFilterString() to create this.
' Default = All Files, *.*
strFilter As String
' Initial Filter to display.
' Default = 1.
lngFilterIndex As Long
' Initial directory for the dialog to open in.
' Default = Current working directory.
strInitialDir As String
' Initial file name to populate the dialog with.
' Default = "".
strInitialFile As String
strDialogTitle As String
' Default extension to append to file if user didn't specify one.
' Default = System Values (Open File, Save File).
strDefaultExtension As String
' Flags (see constant list) to be used.
' Default = no flags.
lngFlags As Long
' Full IconPath of file picked. When the File Open dialog box is
' presented, if the user picks a nonexistent file,
' only the text in the "File Name" box is returned.
strFullIconPathReturned As String
' File name of file picked.
strFileNameReturned As String
' Offset in full IconPath (strFullIconPathReturned) where the file name
' (strFileNameReturned) begins.
intFileOffset As Integer
' Offset in full IconPath (strFullIconPathReturned) where the file
extension begins.
intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OpenFilename
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_IconPathMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Function FindFile(strSearchIconPath$, fName$) As String
' Displays the Open dialog box for the user to locate
' the Northwind database. Returns the full IconPath to Northwind.

Dim msaof As MSA_OPENFILENAME
Dim Extension$

' Set options for the dialog box.
msaof.strDialogTitle = "Where Is " & fName & " ?"
msaof.strInitialDir = strSearchIconPath
msaof.strFilter = MSA_CreateFilterString("." & Right$(fName, 3), "",
"*.*")
msaof.strDefaultExtension = "." & Right$(fName, 3)
msaof.strInitialFile = fName

' Call the Open dialog routine.
MSA_GetOpenFileName msaof

' Return the IconPath and file name.
FindFile = Trim(msaof.strFullIconPathReturned)

End Function

Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
' Creates a filter string from the passed in arguments.
' Returns "" if no argumentss are passed in.
' Expects an even number of argumentss (filter name, extension), but
' if an odd number is passed in, it appends "*.*".

Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer

intNum = UBound(varFilt)
If (intNum <> -1) Then
For intRet = 0 To intNum
strFilter = strFilter & varFilt(intRet) & vbNullChar
Next
If intNum Mod 2 = 0 Then
strFilter = strFilter & "*.*" & vbNullChar
End If

strFilter = strFilter & vbNullChar
Else
strFilter = ""
End If
MSA_CreateFilterString = strFilter

End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer

' Opens the Open dialog.

Dim of As OpenFilename
Dim intRet As Integer

MSAOF_to_OF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet

End Function

Private Sub OF_to_MSAOF(of As OpenFilename, msaof As MSA_OPENFILENAME)

' This sub converts from the Win32 structure to the Microsoft Access
structure.

msaof.strFullIconPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile,
vbNullChar) - 1)
msaof.strFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension

End Sub

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OpenFilename)

' This sub converts from the Microsoft Access structure to the Win32
structure.

Dim strFile As String * 512

' Initialize some parts of the structure.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0

If msaof.strFilter = "" Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex

of.lpstrFile = msaof.strInitialFile _
& String(512 - Len(msaof.strInitialFile), 0)
of.nMaxFile = 511

of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511

of.lpstrTitle = msaof.strDialogTitle

of.lpstrInitialDir = msaof.strInitialDir

of.lpstrDefExt = msaof.strDefaultExtension

of.Flags = msaof.lngFlags

of.lStructSize = Len(of)

End Sub





"thread" wrote in message
news:7c852140-2ccd-4f20-84b1-30ffb91c63ea@l32g2000hse.google groups.com...
> Hi All
>
> i'm trying to build a parallel function in vba access that appear in
> excel:
>
> FileDialog(msoFileDialogFolderPicker)
>
> does anyone know how to choose only a folder through VBA in Access?

Re: choosing folder in vba-access

"thread" wrote in message
news:7c852140-2ccd-4f20-84b1-30ffb91c63ea@l32g2000hse.google groups.com...
> Hi All
>
> i'm trying to build a parallel function in vba access that appear in
> excel:
>
> FileDialog(msoFileDialogFolderPicker)
>
> does anyone know how to choose only a folder through VBA in Access?

Code for using the Windows API function "Browse for Folder" can be found at
http://www.mvps.org/access/api/api0002.htm. That site, by the way, is laden
with good information and tips -- it's a resource you ought to remember.

And, one comment... I believe the Excel method you describe requires an
ActiveX control, with attendant hassles in including and distributing the
ActiveX. The API method does not... it uses Windows functions that are
already on the user's machine.

Larry Linson
Microsoft Access MVP

Re: choosing folder in vba-access

thank you it was very helpfull
On 18 ינואר, 20:49, "Larry Linson" st.not> wrote:
> "thread" wrote in message
>
> news:7c852140-2ccd-4f20-84b1-30ffb91c63ea@l32g2000hse.google groups.com...
>
> > Hi All
>
> > i'm trying to build a parallel function in vba access that appear in
> > excel:
>
> > FileDialog(msoFileDialogFolderPicker)
>
> > does anyone know how to choose only a folder through VBA in Access?
>
> Code for using the Windows API function "Browse for Folder" can be found a=
thttp://www.mvps.org/access/api/api0002.htm.  That site, by the way, is=
laden
> with good information and tips -- it's a resource you ought to remember.
>
> And, one comment... I believe the Excel method you describe requires an
> ActiveX control, with attendant hassles in including and distributing the
> ActiveX.  The API method does not... it uses Windows functions that a=
re
> already on the user's machine.
>
>  Larry Linson
>  Microsoft Access MVP