'例: 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
|