Microsoft Common Dialog

[kryles]

Hi all,

I need a dialog box for Access 2000 that will allow users to choose a folder location. I googled and I read you should be able to choose this object from the Toolbox section. When I click and get the dropdown I don't see this type of object listed.

Is there a file that needs to be referenced that I am missing? How should I go about this?

Thanks,

 

[jal]

Access 2002 and forward has a file dialog, and I'm guessing 97 did as well. 2000 probably doesn't have it.

The windows API is probably better anyway because it doesn't depend on the MS Office DLL. You can hide this code away in a Module to make it less intrusive.


For a fuller version see either:
http://www.access-programmers.co.uk/forums/showthread.php?t=97787&highlight=dialog
http://www.mvps.org/access/api/api0001.htm
http://support.microsoft.com/kb/888695

Sample filter string - this one for excel files (the Chr(0) functions like the vertical bar in VB.Net filters).
Dim filter As String
filter = "Excel files(*.xls)" & Chr(0) & "*.xls" & Chr(0) & "All Files (*.*)" & Chr(0) & "*.*"
and one for JPEG files:
sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
"JPEG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)


Public Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
Public Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
Public Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Public Type tagOPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
strFilter As String
strCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
strFile As String
nMaxFile As Long
strFileTitle As String
nMaxFileTitle As Long
strInitialDir As String
strTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
strDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

'Pass in a boolean indicating whether this is a SaveFileDialog. If false, it will be an ope fileEDialog.
Private Function ShowFileDialog(ByVal SaveFileDialog As Boolean, strFilter As String, strTitle As String, ByVal strInitialDirec As String)
Dim OFN As tagOPENFILENAME
Dim strFileName As String, strFileTitle As String
strFileName = VBA.Left(strFileName & String(256, 0), 256)
strFileTitle = String(256, 0)
With OFN
.lStructSize = Len(OFN)
'.hwndOwner = Application.hWndAccessApp
.strFilter = strFilter
.nFilterIndex = 0
.strFile = VBA.Left(strFileName & String(256, 0), 256)
.nMaxFile = VBA.Len(strFileName)
.strFileTitle = String(256, 0)
.nMaxFileTitle = VBA.Len(strFileTitle)
.strTitle = strTitle
.Flags = 0
.strDefExt = ""
.strInitialDir = strInitialDirec
.strCustomFilter = ""
.nMaxCustFilter = 0
.lpfnHook = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
End With
If SaveFileDialog Then aht_apiGetSaveFileName OFN Else aht_apiGetOpenFileName OFN
'The string returned is 256 chars long, ending in nulls. Remove the nulls.
ShowFileDialog = OFN.strFile
If VBA.Len(OFN.strFile & "") = 0 Then Exit Function
Dim i As Long
For i = VBA.Len(OFN.strFile) To 1 Step -1
If VBA.Mid(OFN.strFile, i, 1) <> Constants.vbNullChar Then Exit For
Next i
ShowFileDialog = VBA.Mid(OFN.strFile, 1, i)
End Function

 

[jal]

Oh woops, you said FOLDER dialog. Here's two options:

Add a REference to Microsoft Shell Controls and automation)
Dim shell1 As New Shell32.Shell, pathToFolder As String
pathToFolder = shell1.BrowseForFolder(0, "Choose a folder", 0).self.Path
MsgBox (pathToFolder)



Windows API

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


Public Function BrowseDirectory(szDialogTitle As String) As String
On Error Resume Next
Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String, wPos As Integer
bi.lpszTitle = szDialogTitle
bi.ulFlags = &H1
dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
BrowseDirectory = ""
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
If X Then
wPos = InStr(szPath, Chr(0))
BrowseDirectory = Left$(szPath, wPos - 1)
End If
if err.Number > 0 Then
msgBox err.Description
BrowseDirectory = ""
end if
End Function

 

[kryles]

Hi Jal,

Great the Browse dialog box comes up, thanks! My only issue now it says that the object is locked when I try exporting from a query.

Run-time Error '3027':
 
Cannot update. Database or object is read-only

This is the code I'm trying to use

Dim qrySweep As String
qrySweep = "qryName"
    Dim shell1 As New Shell32.Shell
    Dim pathToFolder As String
 
    pathToFolder = shell1.BrowseForFolder(0, "Choose Location To Save File", 0).Self.Path
    DoCmd.TransferText acExportDelim, , qrySweep, pathToFolder, True

Any suggestions hehe

EDIT: Well it seems the transfer is what is locking up, my mistake. I'll ry compact repair and see what happens

 

[kryles]

Simple solution, I put the path in the Export but not the name of the file. Interesting that you must also append an '\' to the file name. Seems the dialog box doesn't add '\' after the last directory.

    Dim shell1 As New Shell32.Shell
    Dim pathToFolder As String
    
    pathToFolder = shell1.BrowseForFolder(0, "Choose Location To Save File", 0).Self.Path
    DoCmd.TransferText acExportDelim, , qrySweep, pathToFolder + "\filename.csv", True

Thx so much!