Select a folder for input

  • Thread starter Thread starter Chris Mills
  • Start date Start date
C

Chris Mills

Ah... yes and no ?

Most people avoid the ocx control Microsoft provided for the purpose, because
it is reported to be just so much crap as to compatibility.

Instead, the advice is to use direct system calls. GetOpenFileName in C++ will
demonstrate what you want. Microsoft does not make it easy.

OTOH, someone else might be able to give a link to a vba equivalent. I hope
the code they provide is compatible with all versions of Access.

Chris
 
Is there any code in Vb that open a window
for the user so he select from the list of all folders
in the disk a folder ?
(I want replace the Inputbox() with this window)
 
Go to http://mvps.org/access and search on API. You'll be able to find the
Common Dialogue equivalents. While you're there look into "netiquette",
particularly as it relates to massively cross-posting. I'd already typed
the first sentence of this before I noticed the list of newsgroups. I
rarely respond to anything with more than 3.

hth
 
http://www.mvps.org/access/api/api0002.htm

Gianni, it's never necessary to cross post to so many groups.

Follow-ups trimmed to microsoft.public.access &
microsoft.public.access.externaldata



Is there any code in Vb that open a window
for the user so he select from the list of all folders
in the disk a folder ?
(I want replace the Inputbox() with this window)
Click to expand...

John Nurick [Microsoft Access MVP]

Please respond in the newgroup and not by email.
 
Make a class module called fileDialog

Option Explicit

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

Private Declare Function GetSaveFileName Lib _
"comdlg32.dll" _
Alias "GetSaveFileNameA" (lpOpenFilename As
OPENFILENAME) _
As Long

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

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

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
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_DONTGOBELOWDOMAIN = &H2
Const BIF_STATUSTEXT = &H4
Const BIF_RETURNFSANCESTORS = &H8
Const BIF_BROWSEFORCOMPUTER = &H1000
Const BIF_BROWSEFORPRINTER = &H2000


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
Function fdlgGetOpenFileName(strFilter As String)
Dim rc As Long
Dim pOpenFileName As OPENFILENAME
Const MAX_BUFFER_LENGTH = 256
With pOpenFileName
.hwndOwner = Application.hWndAccessApp
.lpstrTitle = "Open"
.lpstrInitialDir = CurrentProject.Path
.lpstrFilter = Replace(strFilter, ";", Chr(0))
.nFilterIndex = 1
.lpstrFile = String(MAX_BUFFER_LENGTH, 0)
.nMaxFile = MAX_BUFFER_LENGTH - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = MAX_BUFFER_LENGTH - 1
.lStructSize = Len(pOpenFileName)
End With
rc = GetOpenFileName(pOpenFileName)
If rc Then
fdlgGetOpenFileName = Left(pOpenFileName.lpstrFile,
pOpenFileName.nMaxFile)
Else
fdlgGetOpenFileName = ""
End If
End Function
Function fdlgGetSaveFileName(strFilter As String, strPath
As String, Optional strDefExt As String)
Dim rc As Long
Dim pOpenFileName As OPENFILENAME
Const MAX_BUFFER_LENGTH = 256
With pOpenFileName
.hwndOwner = Application.hWndAccessApp
.lpstrTitle = "Save"
.lpstrInitialDir = strPath 'CurrentProject.Path
.lpstrFilter = Replace(strFilter, ";", Chr(0))
.nFilterIndex = 1
.lpstrDefExt = strDefExt
.lpstrFile = String(MAX_BUFFER_LENGTH, 0)
.nMaxFile = MAX_BUFFER_LENGTH - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = MAX_BUFFER_LENGTH - 1
.lStructSize = Len(pOpenFileName)
End With
rc = GetSaveFileName(pOpenFileName)
If rc Then
fdlgGetSaveFileName = Left(pOpenFileName.lpstrFile,
pOpenFileName.nMaxFile)
Else
fdlgGetSaveFileName = pOpenFileName.lpstrFile '""
End If
End Function
Function fdlgGetFolder(Optional Title As String, _
Optional Hwnd) As String
Dim bi As BROWSEINFO
Dim PIDL As Long
Dim Folder As String
Folder = String(255, Chr$(0))
With bi
If IsNumeric(Hwnd) Then .hOwner = Hwnd
.ulFlags =
BIF_DONTGOBELOWDOMAIN 'BIF_RETURNFSANCESTORS '&
BIF_DONTGOBELOWDOMAIN
.pidlRoot = 0
If Title <> "" Then
.lpszTitle = Title & Chr(0)
Else
.lpszTitle = "Select a Folder"
End If
End With
PIDL = SHBrowseForFolder(bi)
If SHGetPathFromIDList(ByVal PIDL, ByVal Folder) Then
fdlgGetFolder = Folder
Else
fdlgGetFolder = "" 'Folder
End If
End Function
 
Back
Top