Printable View
Hi Codegurus,
I want to use the commondialog control in vba, in access.
The user should choose a folder to store a file in. But i don't want to use a textbox for the input, it should be comfortable, like the common dialog control in vb.
thx in advance,
Tom from Germany (that explains my bad english, but doesn't excuse it ;)
Give this a try.
**************Your main procedure**************
Dim Work as typCommonDialog
Dim FileName as string
Dim TempFile as string
TempFile = "ABC.xls"
With Work 'See page 1140 - 1144 of Sybex Access 97 Developers Handbook
.hwndOwner = Application.hWndAccessApp
.AppName = "Excel Spread Sheet"
.DlgTitle = "Export to Excel"
.OpenTitle = "Export"
.File = TempFile
.InitialDir = "F:\"
.Filter = "Excel (*.xls)|All Files (*.*)|"
.FilterIndex = 0
.View = conViewList
.Flags = conNoChangeDir Or conInitializeView
End With
If fxnCommonDialog(Work, false) = conAccErrSuccess then 'for saving a file
'If fxnCommonDialog(Work, true) = conAccErrSuccess then 'for loading a file
FileName = Trim(Work.File)
'Do something with the file name here.
End If
****************Function used**************************
Function fxnCommonDialog(Work as typCommonDialog, byval fOpen as Integer) as Long
' Use the Office file selector common dialog
' exposed by Access.
Dim Hold as Long
With Work
.AppName = RTrim$(.AppName) & vbNullChar
.DlgTitle = RTrim$(.DlgTitle) & vbNullChar
.OpenTitle = RTrim$(.OpenTitle) & vbNullChar
.File = RTrim$(.File) & vbNullChar
.InitialDir = RTrim$(.InitialDir) & vbNullChar
.Filter = RTrim$(.Filter) & vbNullChar
SysCmd acSysCmdClearHelpTopic
Hold = API_OfficeGetFileName(Work, fOpen)
.AppName = RTrim$(fxnTrimNull(.AppName))
.DlgTitle = RTrim$(fxnTrimNull(.DlgTitle))
.OpenTitle = RTrim$(fxnTrimNull(.OpenTitle))
.File = RTrim$(fxnTrimNull(.File))
.InitialDir = RTrim$(fxnTrimNull(.InitialDir))
.Filter = RTrim$(fxnTrimNull(.Filter))
End With
fxnCommonDialog = Hold
End Function
***************Module***************************
Const conDatasheetView = 2
public Const conTwipsPerInch = 1440
Const conMaxTwips = 22 * conTwipsPerInch
Const conErrDivisionByZero = 11
Const conErrInvalidProperty = 2455
public Const conAccErrSuccess = 0
public Const conAccErrUnknown = -1
public Const conConfirmReplace = &H1 ' Prompt if overwriting a file?
public Const conNoChangeDir = &H2 ' Disable the read-only option
public Const conAllowReadOnly = &H4 ' Don't change to the directory the user selected?
public Const conAllowMultiSelect = &H8 ' Allow multiple-selection?
public Const conDirectoryOnly = &H20 ' Open as directory picker?
public Const conInitializeView = &H40 ' Initialize the view to the lView member or use last selected view?
public Const conViewDetails = 0 ' Details
public Const conViewPreview = 1 ' Preview
public Const conViewProperties = 2 ' Properties
public Const conViewList = 3 ' List (typical)
Type typDimensions
tLeft as Single
tTop as Single
tWidth as Single
tHeight as Single
tCtlName as string
End Type
Type typRect
X1 as Long
Y1 as Long
X2 as Long
Y2 as Long
End Type
Type typCommonDialog
hwndOwner as Long
AppName as string * 255
DlgTitle as string * 255
OpenTitle as string * 255
File as string * 4096
InitialDir as string * 255
Filter as string * 255
FilterIndex as Long
View as Long
Flags as Long
End Type
Declare Function API_OfficeGetFileName Lib "msaccess.exe" Alias "#56" (Work as typCommonDialog, byval fOpen as Integer) as Long
TB_Guy_2000
First of all, thx for the code.
But i don't know, if it works, because the function
fxnTrimNull
is not defined...
please add it
many thx,
tom