在当前文件夹中打开对话框窗口

Option Explicit
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHOWHELP = &H10
Public Const OFS_MAXPATHNAME = 128
 
Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS
Public Const OFS_FILE_SAVE_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
Public Const OFS_MULTIFILE_OPEN_FLAGS = OFN_ALLOWMULTISELECT Or OFN_EXPLORER Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS
Public Type OPENFILENAME
    nStructSize As Long
    hwndOwner As Long
    hInstance As Long
    sFilter As String
    sCustomFilter As String
    nCustFilterSize As Long
    nFilterIndex As Long
    sFile As String
    nFileSize As Long
    sFileTitle As String
    nTitleSize As Long
    sInitDir As String
    sDlgTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExt As Integer
    sDefFileExt As String
    nCustDataSize As Long
    fnHook As Long
    sTemplateName As String
End Type
 
Public Llama As OPENFILENAME
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Declare Function SetCurrentDirectory Lib "kernel32" Alias "SetCurrentDirectoryA" (ByVal lpPathName As String) As Long
'  +--------------------------------------------------------------------+
'  |             -= Main sub to call File SAVE Dialog =-                |
'  |                                                                    |
'  | Parameters: FileName$ is a variable that the name of the SAVED     |
'  |            file name is returned in. You do NOT have to pass       |
'  |            a filename to this routine, one is returned. Note       |
'  |            that the Win API checks for, and prompts, if the        |
'  |            filename already exists.                                |
'  |                                                                    |
'  |            FileExt$ is the file extension name you wish the        |
'  |            Dialog box to use, for default extension, file          |
'  |            listings, and availablity innthe drop-down "file        |
'  |            type" box.                                              |
'  |                                                                    |
'  |            FileDesc$ is a descriptive name for the File Name       |
'  |            Extension, used to describe the filetype in the drop    |
'  |            down type box.                                          |
'  |                                                                    |
'  |            DlgTitle$ is the name of the caption on the Dialog      |
'  |                                                                    |
'  |                                                                    |
'  +--------------------------------------------------------------------+
Public Sub SaveFile(hWnd As Long, FileName$, FileExt$, FileDesc$, DlgTitle$)
  Dim lngGo As Long
  Dim lngHwnd As Long
  Dim strCurName As String
  Dim strNewName As String
    On Error GoTo Err_Control
    strCurName = FileName$
    lngHwnd = hWnd
    FileName$ = vbdShowSave(lngHwnd, strCurName, FileExt$, FileDesc$, DlgTitle$)
    Exit Sub
Err_Control:
    'Just get out, to many things to account for
    MsgBox Err.Description, vbCritical, "Too many errors, aborting"
End Sub
'  +--------------------------------------------------------------------+
'  |             -= Main sub to call File OPEN Dialog =-                |
'  |                                                                    |
'  | Parameters: FileName$ is a variable that the name of the SAVED     |
'  |            file name is returned in. You do NOT have to pass       |
'  |            a filename to this routine, one is returned.            |
'  |                                                                    |
'  |            FileExt$ is the file extension name you wish the        |
'  |            Dialog box to use, for default extension, file          |
'  |            listings, and availablity innthe drop-down "file        |
'  |            type" box.                                              |
'  |                                                                    |
'  |            FileDesc$ is a descriptive name for the File Name       |
'  |            Extension, used to describe the filetype in the drop    |
'  |            down type box.                                          |
'  |                                                                    |
'  |                                                                    |
'  |            DlgTitle$ is the name of the caption on the Dialog      |
'  |                                                                    |
'  |                                                                    |
'  +--------------------------------------------------------------------+
Public Sub FileOpen(hWnd As Long, FileName$, FileExt$, FileDesc$, DlgTitle$)
    
    Dim lngGo As Long
    Dim lngHwnd As Long
    Dim strCurName As String
    Dim strNewName As String
    On Error GoTo Err_Control
    strCurName = FileName$
     lngHwnd = hWnd
    strNewName = vbdShowOpen(lngHwnd, strCurName, FileExt$, FileDesc$, DlgTitle$)
    FileName$ = strNewName
Exit Sub
Err_Control:
    'Just get out, to many things to account for
    MsgBox Err.Description, vbCritical, "Too many errors, aborting"
End Sub
'   +---------------------------------------------------------------+
'   |   Interface from the "OpenFile" routine to the Windows API     |
'   +---------------------------------------------------------------+
Public Function vbdShowOpen(lngHwnd As Long, strDwgName As String, FileExt$, FileDesc$, DlgTitle$) As Variant
 Dim lngReturn As Long, ShortSize As Long
 Dim LongName As String, shortName As String, strFill As String
 Dim strDblSpace As String, strFilter As String
    strFill = Chr(0): strDblSpace = strFill & strFill
    Llama.nStructSize = Len(Llama)
    Llama.hwndOwner = lngHwnd
    'This section is for the filter drop down list
      strFilter = FileDesc$ & strFill & FileExt$ & strFill
      strFilter = strFilter & "All Files" & strFill & "*.*" & strDblSpace
      Llama.sFilter = strFilter
    'This is the default information for the dialog
      Llama.sFile = strDwgName & Space$(1024) & strFill
      Llama.nFileSize = Len(Llama.sFile)
      Llama.sDefFileExt = FileExt$
     
      Llama.sFileTitle = Space(512)
      Llama.nTitleSize = Len(Llama.sFileTitle)
      Llama.sInitDir = CurDir
      Llama.sDlgTitle = DlgTitle$
     
    ' use below to call open dialog
      Llama.flags = OFS_FILE_OPEN_FLAGS
      lngReturn = GetOpenFileName(Llama)
    
      If lngReturn Then
         vbdShowOpen = Llama.sFile
      End If
End Function
'   +---------------------------------------------------------------+
'   |   Interface from the "SaveFile" routine to the Windows API     |
'   +---------------------------------------------------------------+
Public Function vbdShowSave(lngHwnd As Long, strDwgName As String, FileExt$, FileDesc$, Caption$) As String
  Dim lngReturn As Long, ShortSize As Long
  Dim LongName As String, shortName As String
  Dim strFill As String, strDblSpace As String, strFilter As String
  strFill = Chr(0): strDblSpace = strFill & strFill
  Llama.nStructSize = Len(Llama)
  Llama.hwndOwner = lngHwnd
    
  'This section is for the filter drop down list
    strFilter = FileDesc$ & strFill & FileExt$ & strFill
    strFilter = strFilter & "All Files" & strFill & "*.*" & strDblSpace
    Llama.sFilter = strFilter
  'This is the default information for the dialog
    Llama.sFile = strDwgName & Space$(1024) & strFill
    Llama.nFileSize = Len(Llama.sFile)
    Llama.sDefFileExt = FileExt$
     
    Llama.sFileTitle = Space(512)
    Llama.nTitleSize = Len(Llama.sFileTitle)
    Llama.sInitDir = CurDir
    Llama.sDlgTitle = Caption$
     
  ' use below to call save dialog
    Llama.flags = OFS_FILE_SAVE_FLAGS
    lngReturn = GetSaveFileName(Llama)
    
    If lngReturn Then
      vbdShowSave = Llama.sFile
    End If
End Function