当前位置: 代码迷 >> VBA >> API调用打开文件对话框出现的有关问题
  详细解决方案

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

热度:3755   发布时间:2013-02-26 00:00:00.0
API调用打开文件对话框出现的问题
网上下载到的下面的API代码--用来调出选择文件的窗口。但是当我运行的时候,点击截图中的取消按钮时候,程序会报错退出,请问我应该怎么做?


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


VB code
Option ExplicitPrivate Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As String) As LongPrivate Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As LongPrivate Declare Function GlobalCompact Lib "kernel32" (ByVal dwMinFree As Long) As LongPrivate Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As LongPrivate Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As LongPrivate Declare Function GlobalReAlloc Lib "kernel32" (ByVal hMem As Long, ByVal dwBytes As Long, ByVal wFlags As Long) As LongPrivate Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As LongPrivate Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As LongPrivate 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 = 32767Private Const MAX_FILE = 32767Private 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 LongEnd TypePrivate Declare Function GetOpenFileName Lib "COMDLG32" _    Alias "GetOpenFileNameA" (file As OpenFileName) As LongPrivate Declare Function GetSaveFileName Lib "COMDLG32" _    Alias "GetSaveFileNameA" (file As OpenFileName) As LongPrivate Declare Function GetFileTitle Lib "COMDLG32" _    Alias "GetFileTitleA" (ByVal szFile As String, _    ByVal szTitle As String, ByVal cbBuf As Long) As LongPublic 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 = &H200000End EnumPrivate Const CCHDEVICENAME = 32Private Const CCHFORMNAME = 32 Private m_lApiReturn As LongPrivate m_lExtendedError As Long Public Property Get APIReturn() As Long     APIReturn = m_lApiReturnEnd PropertyPublic Property Get ExtendedError() As Long     ExtendedError = m_lExtendedErrorEnd Property#If fComponent ThenPrivate Sub Class_Initialize()    InitColorsEnd Sub#End IfFunction 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 = 0With 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 SelectEnd WithEnd Function
  相关解决方案