'例： CommonFileOpenSave(, , "所有文件(*.*)" & Chr(0) & "*.*" & Chr(0))
Option Compare Database
Option Explicit
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
Private Declare Function apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (ofn As tagOPENFILENAME) As Boolean
Private Declare Function apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (ofn As tagOPENFILENAME) As Boolean
Public Function CommonFileOpenSave( _
Optional ByRef flags As Variant, _
Optional ByVal InitialDir As Variant, _
Optional ByVal Filter As Variant, _
Optional ByVal FilterIndex As Variant, _
Optional ByVal DefaultExt As Variant, _
Optional ByVal Filename As Variant, _
Optional ByVal DialogTitle As Variant, _
Optional ByVal hwnd As Variant, _
Optional ByVal OpenFile As Variant) As Variant
Dim ofn As tagOPENFILENAME
Dim strFilename As String
Dim strFileTitle As String
Dim fResult As Boolean
Dim strErrNotes As String
On Error GoTo CommonFileOpenSave_Error
If IsMissing(InitialDir) Then InitialDir = CurDir
If IsMissing(Filter) Then Filter = ""
If IsMissing(FilterIndex) Then FilterIndex = 1
If IsMissing(flags) Then flags = 0&
If IsMissing(DefaultExt) Then DefaultExt = ""
If IsMissing(Filename) Then Filename = ""
If IsMissing(DialogTitle) Then DialogTitle = ""
If IsMissing(hwnd) Then hwnd = Application.hWndaccessApp
If IsMissing(OpenFile) Then OpenFile = True
strFilename = Left(Filename & String$(255, 0), 255)
strFileTitle = String$(255, 0)
With ofn
.lStructSize = Len(ofn)
.hwndOwner = hwnd
.strFilter = Filter
.nFilterIndex = FilterIndex
.strFile = strFilename
.nMaxFile = Len(strFilename)
.strFileTitle = strFileTitle
.nMaxFileTitle = Len(strFileTitle)
.strTitle = DialogTitle
.flags = flags
.strDefExt = DefaultExt
.strInitialDir = InitialDir
.hInstance = 0
.strCustomFilter = String(255, 0)
.nMaxCustFilter = 255
.lpfnHook = 0
End With
If OpenFile Then
fResult = apiGetOpenFileName(ofn)
Else
fResult = apiGetSaveFileName(ofn)
End If
If fResult Then
If Not IsMissing(flags) Then flags = ofn.flags
CommonFileOpenSave = TrimNull(ofn.strFile)
Else
CommonFileOpenSave = Null
End If
CommonFileOpenSave_WrapUp:
Exit Function
CommonFileOpenSave_Error:
CommonFileOpenSave = Null
GoTo CommonFileOpenSave_WrapUp
End Function
Public Function AddFilterItem(strFilter As String, _
strDescription As String, Optional varItem As Variant) As String
Dim strErrNotes As String
If IsMissing(varItem) Then varItem = "*.*"
AddFilterItem = strFilter & _
strDescription & vbNullChar & _
varItem & vbNullChar
End Function
Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
Dim strErrNotes As String
intPos = InStr(strItem, vbNullChar)
If intPos > 0 Then
TrimNull = Left(strItem, intPos - 1)
Else
TrimNull = strItem
End If
End Function
