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

 
 
 
 

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值