การใช้งาน Common Dialog ใน VBA

ผมพยายามที่จะใช้ Save Dialog ใน VBA ของ Access แต่ไม่ได้ผล ผมจึงลอง Search ใน Google ดู ปรากฏว่าได้ผลดีเยี่ยมครับ ใคร ที่เจอปัญหาเดียวกัน copy ไปใช้ได้เลยนะครับ

ได้มาจากที่นี่ครับ ->เรื่อง How do select a file using the a dialog box http://www.tek-tips.com/faqs.cfm?fid=2484

เนื้อหานะครับ คือ ว่า เราจะต้องสร้าง Class Module ชื่อ clsCommonDialog ครับ จากนั้น copy ข้อความดังนี้ใส่ลงไปครับ

อ่านเพิ่มเรื่องอื่นๆได้ที่ www.piyanat.net

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CommonDialog class '
' '
' This module contains an interface to the Common '
' Dialog File Open/Save functions. It may be enhanced '
' for other Common Dialog functions at a future date. '
' '
' This object presents exactly the same interface as '
' the Microsoft Common Dialog 6.0 library from Visual '
' Basic 6.0 (comdlg32.dll). '
' '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Values for the Flags property; multiple values can be ORed together.
' In versions of Access prior to Access 2000, comment or delete these
' and use the CommonDialogConstants module (Enum keyword is not
' valid in these versions).
Public Enum CmdlgOpenFlags
cdlOFNAllowMultiselect = &H200
cdlOFNCreatePrompt = &H2000
cdlOFNExplorer = &H80000
cdlOFNFileMustExist = &H1000
cdlOFNHideReadOnly = &H4
cdlOFNNoChangeDir = &H8
cdlOFNNoDereferenceLinks = &H100000
cdlOFNNoNetworkButton = &H20000 ' not documented for common dlg
cdlOFNNoReadOnlyReturn = &H8000
cdlOFNNoValidate = &H100
cdlOFNOverwritePrompt = &H2
cdlOFNPathMustExist = &H800
cdlOFNReadOnly = &H1
cdlOFNShowHelp = &H10
cdlOFNShareAware = &H4000
cdlOFNExtensionDifferent = &H400
End Enum

' Errors raised
Public Enum CmdlgErrors
cdlCancel = 32755 ' user pressed Cancel in dialog
End Enum

' Filter string used for the Open/Save dialog filters (the
' "Files of type" combo box). The string consists of a list of
' filter specs, each of which consists of a pair of elements.
' The first element of each spec is the description to appear
' in the combo box, and the second is a filter pattern. When
' the user selects the description, the corresponding pattern
' is used to filter the list of files in the file list box.
' A pipe character ("|") separates each element of the string.
' Example: "Database Files|*.mdb|All Files|*.*"
Public Filter As String
' Initial Filter to display. This sets/returns the index of the
' currently selected item in the filter combo box.
Public FilterIndex As Long
' Initial directory for the dialog to open in.
' Default = Current working directory.
Public InitDir As String
' Initial file name to populate the dialog with. Default = "".
' Returns the full path name of the selected file.
Public FileName As String
' Returns file name (without path) of file picked
Public FileTitle As String
' Title to appear on the dialog box.
Public DialogTitle As String
' Default extension to append to file if user didn't specify one.
Public DefaultExt As String
' Flags (see constant list) to be used.
' Returns cdlOFNDifferentExtension if extension present and not = DefaultExt
Public Flags As Long
' Maximum length of the file name to be returned
Public MaxFileSize As Integer
' Set to True to raise error 32755 if user cancels dialog box
Public CancelError As Boolean

' Constants used when raising errors
Private Const ErrSource = "MyComDlg.CommonDialog"

' Interface to Win32
Private Type W32_OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustrFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
lngFlags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long 'String
End Type

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

Private Sub Class_Initialize()
' Initialize the MaxFileSize to minimum, in case the user doesn't set it
MaxFileSize = 256
End Sub

Public Sub ShowOpen()
' Shows the Open dialog

Dim wofn As W32_OPENFILENAME
Dim intRet As Integer

OFN_to_WOFN wofn
On Error GoTo ShowOpen_Error
intRet = GetOpenFileName(wofn)
On Error GoTo 0
WOFN_to_OFN wofn
If (intRet = 0) And CancelError Then _
Err.Raise cdlCancel, ErrSource, "File open canceled by user"
Exit Sub

ShowOpen_Error:
WOFN_to_OFN wofn
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, _
Err.HelpContext
End Sub

Public Sub ShowSave()
' Shows the Save dialog

Dim wofn As W32_OPENFILENAME
Dim intRet As Integer

OFN_to_WOFN wofn
On Error GoTo ShowSave_Error
intRet = GetSaveFileName(wofn)
On Error GoTo 0
WOFN_to_OFN wofn
If (intRet = 0) And CancelError Then _
Err.Raise cdlCancel, ErrSource, "File save canceled by user"
Exit Sub

ShowSave_Error:
WOFN_to_OFN wofn
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, _
Err.HelpContext
End Sub

Private Sub OFN_to_WOFN(wofn As W32_OPENFILENAME)
' This sub converts from the Microsoft Access structure to the Win32 structure.

' Initialize some parts of the structure.
With wofn
.hwndOwner = Application.hWndAccessApp
.hInstance = 0
.lpstrCustomFilter = vbNullString
.nMaxCustrFilter = 0
.lpfnHook = 0
.lpTemplateName = 0
.lCustrData = 0
.lpstrFilter = ConvertFilterString(Filter)
.nFilterIndex = FilterIndex
If MaxFileSize < maxfilesize =" 256" maxfilesize =" Len(FileName)" nmaxfile =" MaxFileSize" lpstrfile =" FileName" nmaxfiletitle =" 260" lpstrfiletitle =" String(260," lpstrtitle =" DialogTitle" lpstrinitialdir =" InitDir" lpstrdefext =" DefaultExt" lngflags =" Flags" lstructsize =" Len(wofn)" filename =" Left$(.lpstrFile," filetitle =" Left$(.lpstrFileTitle," filterindex =" .nFilterIndex" flags =" .lngFlags" strfilter = "" intnum =" 0" intpos =" 1" intlastpos =" 1" intpos =" InStr(intLastPos,"> intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
intNum = intNum + 1
intLastPos = intPos + 1
ElseIf (intPos = intLastPos) Then
intLastPos = intPos + 1
End If
Loop Until (intPos = 0)

' Get last string if it exists (assuming strFilterIn was not bar terminated).
intPos = Len(strFilterIn)
If (intPos >= intLastPos) Then
strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
intNum = intNum + 1
End If

' Add *.* if there's no extension for the last string.
If intNum Mod 2 = 1 Then
strFilter = strFilter & "*.*" & vbNullChar
End If

' Add terminating NULL
ConvertFilterString = strFilter & vbNullChar
End Function




ส่วน code ตัวอย่างนะครับ

สำหรับ Open Dialog

Sample code:
Dim cmdlgOpenFile As New clsCommonDialog
Dim FileName As String 'full file name
Const clngFilterIndexAll = 5

cmdlgOpenFile.Filter = "Text Files (*.txt)|*.txt|DBF Files (DBF)|*.dbf|All Files (*.*)|*.*"
cmdlgOpenFile.FilterIndex = clngFilterIndexAll
'this is where the dialog opens
cmdlgOpenFile.ShowOpen

'returns your full file name.
FileName = cmdlgOpenFile.FileName

'hence no len, no name...
If Len(FileName) = 0 Then Exit Sub

สำหรับ Save Dialog

Dim cmdlgSaveFile As New clsCommonDialog
Dim FileName As String 'full file name
Const clngFilterIndexAll = 5
With cmdlgSaveFile
.FileName = "Claim.xls"
.Filter = "Excel Files (*.xls)|*.xls"
.FilterIndex = clngFilterIndexAll
.ShowSave
'returns your full file name.
FileName = .FileName
If Len(FileName) = 0 Then Exit Sub
End With