MyException - 我的异常网
当前位置:我的异常网» VBA » API调用打开文件对话框出现的有关问题

API调用打开文件对话框出现的有关问题

www.MyException.Cn  网友分享于:2013-03-16  浏览:32次
API调用打开文件对话框出现的问题
网上下载到的下面的API代码--用来调出选择文件的窗口。但是当我运行的时候,点击截图中的取消按钮时候,程序会报错退出,请问我应该怎么做?


[img][/img]
下面是类模块的代码


VB code

Option Explicit

Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalCompact Lib "kernel32" (ByVal dwMinFree As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalReAlloc Lib "kernel32" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long)
Private Declare Sub CopyMemoryStr Lib "kernel32" Alias "RtlMoveMemory" ( _
    lpvDest As Any, ByVal lpvSource As String, ByVal cbCopy As Long)

 
Private Const MAX_PATH = 32767
Private Const MAX_FILE = 32767


Private 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 Long
End Type

Private Declare Function GetOpenFileName Lib "COMDLG32" _
    Alias "GetOpenFileNameA" (file As OpenFileName) As Long
Private Declare Function GetSaveFileName Lib "COMDLG32" _
    Alias "GetSaveFileNameA" (file As OpenFileName) As Long
Private Declare Function GetFileTitle Lib "COMDLG32" _
    Alias "GetFileTitleA" (ByVal szFile As String, _
    ByVal szTitle As String, ByVal cbBuf As Long) As Long

Public Enum EOpenFile
    OFN_READONLY = &H1
    OFN_OVERWRITEPROMPT = &H2
    OFN_HIDEREADONLY = &H4
    OFN_NOCHANGEDIR = &H8
    OFN_SHOWHELP = &H10
    OFN_ENABLEHOOK = &H20
    OFN_ENABLETEMPLATE = &H40
    OFN_ENABLETEMPLATEHANDLE = &H80
    OFN_NOVALIDATE = &H100
    OFN_ALLOWMULTISELECT = &H200
    OFN_EXTENSIONDIFFERENT = &H400
    OFN_PATHMUSTEXIST = &H800
    OFN_FILEMUSTEXIST = &H1000
    OFN_CREATEPROMPT = &H2000
    OFN_SHAREAWARE = &H4000
    OFN_NOREADONLYRETURN = &H8000&
    OFN_NOTESTFILECREATE = &H10000
    OFN_NONETWORKBUTTON = &H20000
    OFN_NOLONGNAMES = &H40000
    OFN_EXPLORER = &H80000
    OFN_NODEREFERENCELINKS = &H100000
    OFN_LONGNAMES = &H200000
End Enum

Private Const CCHDEVICENAME = 32
Private Const CCHFORMNAME = 32
 
Private m_lApiReturn As Long
Private m_lExtendedError As Long
 

Public Property Get APIReturn() As Long
 
    APIReturn = m_lApiReturn
End Property
Public Property Get ExtendedError() As Long
 
    ExtendedError = m_lExtendedError
End Property

#If fComponent Then
Private Sub Class_Initialize()
    InitColors
End Sub
#End If

Function VBGetOpenFileName(FileName As String, _
                           Optional FileTitle As String, _
                           Optional FileMustExist As Boolean = True, _
                           Optional MultiSelect As Boolean = False, _
                           Optional ReadOnly As Boolean = False, _
                           Optional HideReadOnly As Boolean = False, _
                           Optional Filter As String = "All (*.*)| *.*", _
                           Optional FilterIndex As Long = 1, _
                           Optional InitDir As String, _
                           Optional DlgTitle As String, _
                           Optional DefaultExt As String, _
                           Optional Owner As Long = -1, _
                           Optional flags As Long = 0) As Boolean

    Dim opfile As OpenFileName, S As String, afFlags As Long
    
    m_lApiReturn = 0
    m_lExtendedError = 0

With opfile
    .lStructSize = Len(opfile)
    
 
    
    .flags = (-FileMustExist * OFN_FILEMUSTEXIST) Or _
            (-MultiSelect * OFN_ALLOWMULTISELECT) Or _
             (-ReadOnly * OFN_READONLY) Or _
             (-HideReadOnly * OFN_HIDEREADONLY) Or _
             (flags And CLng(Not (OFN_ENABLEHOOK Or _
                                  OFN_ENABLETEMPLATE)))
    
    If (.flags And OFN_ALLOWMULTISELECT) = OFN_ALLOWMULTISELECT Then
        .flags = .flags Or OFN_EXPLORER
    End If
    
 
    If Owner <> -1 Then .hWndOwner = Owner
 
    .lpstrInitialDir = InitDir
 
    .lpstrDefExt = DefaultExt
 
    .lpstrTitle = DlgTitle
    
 
    Dim ch As String, i As Integer
    For i = 1 To Len(Filter)
        ch = Mid$(Filter, i, 1)
        If ch = "|" Or ch = ":" Then
            S = S & vbNullChar
        Else
            S = S & ch
        End If
    Next
    ' Put double null at end
    S = S & vbNullChar & vbNullChar
    .lpstrFilter = S
    .nFilterIndex = FilterIndex

    ' Pad file and file title buffers to maximum path
    S = FileName & String$(MAX_PATH - Len(FileName), 0)
    .lpstrFile = S
    .nMaxFile = MAX_PATH
    S = FileTitle & String$(MAX_FILE - Len(FileTitle), 0)
    .lpstrFileTitle = S
    .nMaxFileTitle = MAX_FILE
    ' All other fields set to zero
    
    m_lApiReturn = GetOpenFileName(opfile)
    Select Case m_lApiReturn
    Case 1
        ' Success
        VBGetOpenFileName = True
        If (.flags And OFN_ALLOWMULTISELECT) Then
            FileName = .lpstrFile
        Else
            FileName = StrZToStr(.lpstrFile)
        End If
        FileTitle = StrZToStr(.lpstrFileTitle)
        flags = .flags
        ' Return the filter index
        FilterIndex = .nFilterIndex
        ' Look up the filter the user selected and return that
        Filter = FilterLookup(.lpstrFilter, FilterIndex)
        If (.flags And OFN_READONLY) Then ReadOnly = True
    Case 0
        ' Cancelled
        VBGetOpenFileName = False
        FileName = ""
        FileTitle = ""
        flags = 0
        FilterIndex = -1
        Filter = ""
    Case Else

    End Select
End With
End Function



文章评论

不懂技术不要对懂技术的人说这很容易实现
不懂技术不要对懂技术的人说这很容易实现
程序员最害怕的5件事 你中招了吗?
程序员最害怕的5件事 你中招了吗?
Web开发人员为什么越来越懒了?
Web开发人员为什么越来越懒了?
什么才是优秀的用户界面设计
什么才是优秀的用户界面设计
鲜为人知的编程真相
鲜为人知的编程真相
团队中“技术大拿”并非越多越好
团队中“技术大拿”并非越多越好
为什么程序员都是夜猫子
为什么程序员都是夜猫子
如何成为一名黑客
如何成为一名黑客
看13位CEO、创始人和高管如何提高工作效率
看13位CEO、创始人和高管如何提高工作效率
写给自己也写给你 自己到底该何去何从
写给自己也写给你 自己到底该何去何从
聊聊HTTPS和SSL/TLS协议
聊聊HTTPS和SSL/TLS协议
程序员都该阅读的书
程序员都该阅读的书
代码女神横空出世
代码女神横空出世
程序员必看的十大电影
程序员必看的十大电影
60个开发者不容错过的免费资源库
60个开发者不容错过的免费资源库
Web开发者需具备的8个好习惯
Web开发者需具备的8个好习惯
程序员周末都喜欢做什么?
程序员周末都喜欢做什么?
那些争议最大的编程观点
那些争议最大的编程观点
“肮脏的”IT工作排行榜
“肮脏的”IT工作排行榜
漫画:程序员的工作
漫画:程序员的工作
 程序员的样子
程序员的样子
当下全球最炙手可热的八位少年创业者
当下全球最炙手可热的八位少年创业者
我跳槽是因为他们的显示器更大
我跳槽是因为他们的显示器更大
科技史上最臭名昭著的13大罪犯
科技史上最臭名昭著的13大罪犯
程序员的鄙视链
程序员的鄙视链
总结2014中国互联网十大段子
总结2014中国互联网十大段子
程序员和编码员之间的区别
程序员和编码员之间的区别
如何区分一个程序员是“老手“还是“新手“?
如何区分一个程序员是“老手“还是“新手“?
旅行,写作,编程
旅行,写作,编程
编程语言是女人
编程语言是女人
中美印日四国程序员比较
中美印日四国程序员比较
做程序猿的老婆应该注意的一些事情
做程序猿的老婆应该注意的一些事情
程序猿的崛起——Growth Hacker
程序猿的崛起——Growth Hacker
程序员眼里IE浏览器是什么样的
程序员眼里IE浏览器是什么样的
Java 与 .NET 的平台发展之争
Java 与 .NET 的平台发展之争
一个程序员的时间管理
一个程序员的时间管理
10个调试和排错的小建议
10个调试和排错的小建议
老美怎么看待阿里赴美上市
老美怎么看待阿里赴美上市
亲爱的项目经理,我恨你
亲爱的项目经理,我恨你
每天工作4小时的程序员
每天工作4小时的程序员
10个帮程序员减压放松的网站
10个帮程序员减压放松的网站
Java程序员必看电影
Java程序员必看电影
我是如何打败拖延症的
我是如何打败拖延症的
初级 vs 高级开发者 哪个性价比更高?
初级 vs 高级开发者 哪个性价比更高?
老程序员的下场
老程序员的下场
软件开发程序错误异常ExceptionCopyright © 2009-2015 MyException 版权所有