Don't bother using it, paste the following code into a class module
and name the module "Dialogs"... (look below code for example on how
to use it)
'--code start--
Option Compare Database
Option Explicit
'Module Name: clsDialogs_DMH v1.3
'Author: Duane Hennessy
'Date: 06.04.2003
'Description: Manages Dialogs.
'Dependencies:
'Notes: Returns an empty string if nothing is chosen. _
Code taken from Developer Web site somewhere.
'Updates: Appropriated FileDialog Code into Class -
28/08/2003 - DMH _
Colour dialog box added. - 14.10.2003 - DMH.
'Usage: Set a variable as follows, _
strReportPath = Open_Folder_Browser("Please choose a folder to
save the report to etc...")
'FOLDER BROWSER VARIABLES AND APIs
Private Type BrowseInfo
Window_Parent As Long
pidlRoot As Long
pszDisplayName As String
DialogWindowTitle 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 pstrBuffer As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BrowseInfo) _
As Long
Private Const ReturnFoldersOnly = &H1
'COLOUR DIALOG VARIABLES AND APIs
Private Type ChooseColour
lngStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColours As String
flags As Long
lCustData As Long
lpfnHook As Long
lTemplateName As String
End Type
Private Declare Function ShowColour Lib "comdlg32.dll"
Alias "ChooseColorA" _
(vChooseColour As ChooseColour) As Long 'Returns a colour
constant
'COMMON FILE DIALOG ARIABLES AND APIs
Private Type OPENFILENAME
lngStructSize As Long ' Size of structure
hwndOwner As Long ' Owner window handle
hInstance As Long ' Template instance handle
strFilter As String ' Filter string
strCustomFilter As String ' Selected filter string
intMaxCustFilter As Long ' Len(strCustomFilter)
intFilterIndex As Long ' Index of filter string
strFile As String ' Selected filename & path
intMaxFile As Long ' Len(strFile)
strFileTitle As String ' Selected filename
intMaxFileTitle As Long ' Len(strFileTitle)
strInitialDir As String ' Directory name
strTitle As String ' Dialog title
lngFlags As Long ' Dialog flags
intFileOffset As Integer ' Offset of filename
intFileExtension As Integer ' Offset of file extension
strDefExt As String ' Default file extension
lngCustData As Long ' Custom data for hook
lngfnHook As Long ' LP to hook function
strTemplateName As String ' Dialog template name
End Type
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (ofn As OPENFILENAME) As Boolean
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
Alias "GetSaveFileNameA" (ofn As OPENFILENAME) As Boolean
' Open/Save dialog flags
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOLONGNAMES = &H40000
' Flags for hook functions and dialog templates
'Private Const OFN_ENABLEHOOK = &H20
'Private Const OFN_ENABLETEMPLATE = &H40
'Private Const OFN_ENABLETEMPLATEHANDLE = &H80
' Windows 95 flags
Private Const OFN_EXPLORER = &H80000
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_LONGNAMES = &H200000
' Custom flag combinations
Private Const dhOFN_OPENEXISTING = OFN_PATHMUSTEXIST Or
OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
Private Const dhOFN_SAVENEW = OFN_PATHMUSTEXIST Or
OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
Private Const dhOFN_SAVENEWPATH = OFN_OVERWRITEPROMPT Or
OFN_HIDEREADONLY
Private Declare Function GetActiveWindow Lib "user32" () As Long
Public Function Open_Folder_Browser(ByVal vstrBrowserWindowTitle As
String) As String
'Author: Duane Hennessy
'Date: 06.04.2003
'Description: Open the folder browsing dialog type.
'Requirements
On Error Resume Next
Dim lngValue As Long
Dim BrowseInfo As BrowseInfo
Dim lngFolderValue As Long
Dim strBuffer As String
Dim wPos As Integer
With BrowseInfo
.Window_Parent = hWndAccessApp
.DialogWindowTitle = vstrBrowserWindowTitle
.ulFlags = ReturnFoldersOnly
End With
lngFolderValue = SHBrowseForFolder(BrowseInfo)
strBuffer = Space$(512)
lngValue = SHGetPathFromIDList(ByVal lngFolderValue, ByVal
strBuffer)
If lngValue Then
wPos = InStr(strBuffer, Chr(0))
Open_Folder_Browser = Left$(strBuffer, wPos - 1)
Else
Open_Folder_Browser = ""
End If
End Function
Function strFile_Dialog( _
Optional strInitDir As String, _
Optional strFilter As String = _
"All files (*.*)" & vbNullChar & "*.*" & _
vbNullChar & vbNullChar, _
Optional intFilterIndex As Integer = 1, _
Optional strDefaultExt As String = "", _
Optional strFileName As String = "", _
Optional strDialogTitle As String = "Open File", _
Optional hWnd As Long = -1, _
Optional fOpenFile As Boolean = True, _
Optional ByRef lngFlags As Long = _
dhOFN_OPENEXISTING) As String
'Author: Duane Hennessy (Taken from
'Date: 28.08.2003
'Description: Open file saving or opening dialog.
Appropriated from:
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights
reserved.
'Requirements: requirements_here
'Updates: I changed this code to return a string
instead of a variant. - 28/08/2003 - DMH
Dim ofn As OPENFILENAME
Dim strFileTitle As String
Dim fResult As Boolean
' Fill in some of the missing arrguments
If strInitDir = "" Then
strInitDir = CurDir
End If
If hWnd = -1 Then
hWnd = GetActiveWindow()
End If
' Set up the return buffers
strFileName = strFileName & String(255 - Len(strFileName), 0)
strFileTitle = String(255, 0)
' Fill in the OPENFILENAME structure members
With ofn
.lngStructSize = Len(ofn)
.hwndOwner = hWnd
.strFilter = strFilter
.intFilterIndex = intFilterIndex
.strFile = strFileName
.intMaxFile = Len(strFileName)
.strFileTitle = strFileTitle
.intMaxFileTitle = Len(strFileTitle)
.strTitle = strDialogTitle
.lngFlags = lngFlags
.strDefExt = strDefaultExt
.strInitialDir = strInitDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.intMaxCustFilter = 255
.lngfnHook = 0
End With
' Call the right function
If fOpenFile Then
fResult = GetOpenFileName(ofn)
Else
fResult = GetSaveFileName(ofn)
End If
' If successful, return the filename,
' otherwise return Null
If fResult Then
' Return any flags to the calling procedure
lngFlags = ofn.lngFlags
' Return the result
If (ofn.lngFlags And OFN_ALLOWMULTISELECT) = 0 Then
strFile_Dialog = dhTrimNull(ofn.strFile)
Else
strFile_Dialog = ofn.strFile
End If
Else
strFile_Dialog = ""
End If
End Function
Public Function Save_File_Browser(Optional ByVal
Initial_Directory_To_Start_In As String = "c:\", _
Optional ByVal File_Type_Name__eg_Excel_File As String = "All
Files", _
Optional ByVal Initial_File_Name_To_Start_With As String
= "NewFile.txt", _
Optional ByVal Save_Dialog_Box_Title As String = "Save As") As
String
'Author: Duane Hennessy
'Date: 28.08.2003
'Description: Open file saving dialog box
'Requirements: requirements_here
'Updates: updates_here
On Error Resume Next
' Save a file as a text file
Save_File_Browser = strFile_Dialog
(Initial_Directory_To_Start_In, _
File_Type_Name__eg_Excel_File, , ,
Initial_File_Name_To_Start_With, _
Save_Dialog_Box_Title, _
lngFlags:=dhOFN_SAVENEW, _
fOpenFile:=False)
End Function
Public Function Open_File_Browser(Optional ByVal
Initial_Directory_To_Start_In As String = "c:\", _
Optional ByVal File_Type_Name__eg_Excel_File As String = "All
Files", _
Optional ByVal Initial_File_Name_To_Start_With As String
= "NewFile.txt", _
Optional ByVal Save_Dialog_Box_Title As String = "Open file") As
String
'Author: Duane Hennessy
'Date: 28.08.2003
'Description: Open file opening dialog box
'Requirements: requirements_here
'Updates: updates_here
On Error Resume Next
Open_File_Browser = strFile_Dialog
(Initial_Directory_To_Start_In, _
File_Type_Name__eg_Excel_File, , ,
Initial_File_Name_To_Start_With, _
Save_Dialog_Box_Title, _
lngFlags:=dhOFN_OPENEXISTING, _
fOpenFile:=True)
End Function
Function dhTrimNull(strval As String) As String
' Trim the end of a string, stopping at the first
' null character.
' From Access 97 Developer's Handbook
' by Litwin, Getz, and Gilbert (Sybex)
' Copyright 1997. All rights reserved.
On Error Resume Next
Dim intPos As Integer
intPos = InStr(strval, vbNullChar)
If intPos > 0 Then
dhTrimNull = Left$(strval, intPos - 1)
Else
dhTrimNull = strval
End If
End Function
Public Function Open_Colour_Chooser_Dialog() As Variant
'Author: Duane Hennessy
'Date: 14.10.2003
'Description: Open colour dialog box and return a chosen
colour.
'Requirements: requirements_here
'Updates: updates_here
'Notes: A return of Null means the user has hit the
cancel button. _
Any other return is a long number colour
return.
On Error Resume Next
'Define array for custom colours
Dim byteCustomColours(15) As Byte
Dim tChooseColour As ChooseColour
Dim lngReturn As Long 'Whether the user cancelled the dialog
box or not.
With tChooseColour
.hwndOwner = Application.hWndAccessApp 'Access handle
.lpCustColours = StrConv(byteCustomColours, vbUnicode)
.flags = 0&
.lngStructSize = Len(tChooseColour)
End With
lngReturn = ShowColour(tChooseColour)
If lngReturn = 0 Then
Open_Colour_Chooser_Dialog = Null
Else
Open_Colour_Chooser_Dialog = tChooseColour.rgbResult
End If
End Function
'--code end--
To use it do something like the following:
Public Sub testDialog()
Dim d As New dialogs
Dim file_name As String
file_name = d.Open_File_Browser("c:\", "All Files", "Optional
File Name.txt", "Open a file for me")
MsgBox file_name
End Sub
This class has the following dialogs.
- Open_File_Browser: Retrieve a file name using the open file dialog.
- Save_File_Browser: Retrieve a file name using the save file dialog.
- Open_Folder_Browser: Retrieve a folder name using the choose
folder dialog.
- Open_Colour_Chooser_Dialog: Opens the colour chooser dialog and
returns a Long colour value.
Let me know how you go.
Duane Hennessy.
Bandicoot Software
Tropical Queensland, Australia
(ABN: 33 682 969 957)
Want Increased Productivity?
http://www.bandicootsoftware.com.au
--- In AccessDevelopers@yahoogroups.com, "bitschon" <[EMAIL PROTECTED]>
wrote:
>
> When I try to put a common dialog control onto a form, I get an
error
> message that I do not have the license required for this. Since
this
> is a standard MS control, I'm pretty confused.
>
> What is wrong? What do I have to do to make this work?
>
> Thanks
> JPS
>
Please zip all files prior to uploading to Files section.
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/AccessDevelopers/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
