comdlg32打开对话框的最终解决方案

comdlg32打开对话框的最终解决方案　[2005-12-27]
'用windows的打开对话框API函数
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
                                     (pOpenFileName As OPENFILENAME) As Long
Type OPENFILENAME
     lStructSize As Long
     hwndOwner As Long
     hInstance As Long
     lpstrFilter As String
     lpstrCustomFilter As String
     nMaxCustFilter As Long
     nFilterIndex As Long
     lpstrFile As String
     nMaxFile As Long
     lpstrFileTitle As String
     nMaxFileTitle As Long
     lpstrInitialDir As String
     lpstrTitle As String
     flags As Long
     nFileOffset As Integer
     nFileExtension As Integer
     lpstrDefExt As String
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As String
End Type
Dim strSOldPathString As String

'
Public Function mOpenDialog(ByVal ohWnd As Form, ByVal sFilter As String) As String
    Dim ofn As OPENFILENAME
    Dim sFileName As String, sNewFilter As String
    On Error GoTo errOpenDialog
   
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = ohWnd.hWnd
    ofn.hInstance = App.hInstance
    If Len(sFilter) = 0 Then
       ofn.lpstrFilter = "所有文件(*.*)" & Chr(0) & "*.*"
    Else
       sNewFilter = mFilterFormat(sFilter)
       ofn.lpstrFilter = "所有文件(*.*)" & Chr(0) & "*.*" & Chr(0) & sNewFilter
    End If
    ofn.lpstrFile = Space(254)
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = App.Path
    ofn.lpstrTitle = "打开文件"
    ofn.flags = 6148
   
    sFileName = GetOpenFileName(ofn)
    If sFileName >= 1 Then
        mOpenDialog = ofn.lpstrFile
        strSOldPathString = ofn.lpstrFile
    Else
        mOpenDialog = strSOldPathString
    End If
    Exit Function
errOpenDialog:
    MsgBox "发生错误:" & Err.Description & Chr(13) + Chr(10) & "错误编号:" & CStr(Err.Number), vbQuestion, "错误"
    Exit Function
End Function

Private Function mFilterFormat(ByVal sString As String) As String
    Dim i As Long, iLen As Long
    Dim sTemp As String
    Dim sMidStr As String
    On Error GoTo errfilter
    iLen = Len(sString)
    For i = 1 To iLen
        sTemp = Mid(sString, i, 1)
        If sTemp = "/" Then
           sTemp = Chr(0)
        End If
        mFilterFormat = mFilterFormat & sTemp
    Next i
    Exit Function
errfilter:
    MsgBox "发生错误:" & Err.Description & Chr(10) + Chr(13) & "错误编号:" & CStr(Err.Number), vbQuestion, "错误"
    Exit Function
End Function
'======目标操作过程＝＝＝＝＝＝＝
'Private Sub OpenObj()
'    Me.Caption = OpenDialog(Me, "Bitmap(*.Bmp)/*.bmp/") '"/"为Filte分隔符'
'    Debug.Print nFile    '测试
'End Sub