comdlg32.dll

dll的应用，目前还不知道要怎么查看dll里的功能，暂且试着用了一个，

下面的Declare 分32位office软件和64位，如果是64位，要在Declare 后面加上PtrSafe ，定义的Type里的Long也最好写成LongPtr

Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) 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

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

Const OFN_SHAREFALLTHROUGH = 2
Const OFN_SHARENOWARN = 1
Const OFN_SHAREWARN = 0

Const MAX_PATH = 260


Sub test1105()

    Debug.Print Get_FileName("D:lcx", "我的测试选择", "XLS", True)

End Sub


'strFilter = 过滤条件
'strInitialDir = 文件起始目录
'strTitle = 标题
'strDefExt = 过滤条件
'blOpen = 选择 True 保存 False
Function spFileDlg(strFilter As String, strInitialDir As String, strTitle As String, strDefExt As String, blOpen As Boolean, FN As String)

    Dim fFileName As OPENFILENAME
    Dim strBuff As String
    Dim accWnd As Long

    Dim lngRet As Long

    accWnd = FindWindow("OMAIN", vbNullString)

    strBuff = FN & String$(MAX_PATH - LenB(FN), 0)

    With fFileName
        .lStructSize = LenB(fFileName)
        .hwndOwner = accWnd
        .hInstance = 0
        .lpstrFilter = strFilter
        .nMaxCustFilter = 0&
        .nFilterIndex = 0
        .lpstrFile = strBuff
        .nMaxFile = MAX_PATH
        .lpstrFileTitle = String$(MAX_PATH, 0)
        .nMaxFileTitle = MAX_PATH + 1
        .lpstrInitialDir = strInitialDir
        .lpstrTitle = strTitle
        .flags = OFN_HIDEREADONLY
        .lpstrDefExt = strDefExt
    End With
    
    If blOpen = True Then
        lngRet = GetOpenFileName(fFileName)
    Else
        lngRet = GetSaveFileName(fFileName)
    End If

    If lngRet <> 0 Then
        spFileDlg = fFileName.lpstrFile
    Else
        spFileDlg = "CANCEL"
    End If
    
End Function


'FN:文件名称
'TL:标题
'TP:文件类型
'OP:true 打开 false 保存
Function Get_FileName(FN As Variant, TL As Variant, TP As Variant, OP As Boolean, Optional DFLG As Boolean = True)

    Dim ret As Variant
    Dim S_DIR As String
    Dim S_FN As String
    Dim l As Integer
    Dim FILENAME As String
    Dim S_TL As String
    Dim S_TP As String
    Dim strFilter As String
    
    Get_FileName = "CANCEL"
    S_TL = TL
    S_TP = TP
    
    If (IsNull(FN) Or (Len(Trim(FN)) = 0)) Then
        S_DIR = ""
        S_FN = ""
    Else
        l = 1
        ret = 1
        Do While (ret > 0)
            ret = InStr(l, FN, "")
            If (IsNull(ret)) Then
                S_DIR = ""
                S_FN = ""
                ret = 0
            End If
            If (ret = 0) Then
                S_DIR = Mid(FN, 1, l - 1)
                S_FN = Mid(FN, l)
            End If
            l = ret + 1
        Loop
    End If
    
    Select Case TP
    Case "TXT"
        strFilter = "TextFile (*.txt)" & vbNullChar & "*.txt" & vbNullChar
    Case "CSV"
        strFilter = "TextFile (*.csv)" & vbNullChar & "*.csv" & vbNullChar
    Case "XLS"
        strFilter = "ExcelFile (*.xls)" & vbNullChar & "*.xls*" & vbNullChar & "TextFile (*.csv)" & vbNullChar & "*.csv" & vbNullChar
    Case "MDB"
        strFilter = "AccessFile (*.mdb)" & vbNullChar & "*.mdb" & vbNullChar
    Case Else
        strFilter = ""
    End Select
    
    strFilter = strFilter & "All File (*.*)" & vbNullChar & "*.*"
    
    FILENAME = spFileDlg(strFilter, S_DIR, S_TL, S_TP, OP, S_FN)
    
    If FILENAME = "CANCEL" Then
        Exit Function
    End If
        
    ret = InStr(1, FILENAME, Chr(0))
    If (IsNull(ret)) Then
        Exit Function
    Else
        If (ret > 0) Then
            FILENAME = Mid(FILENAME, 1, ret - 1)
        End If
    End If
    
    If (OP = False And DFLG) Then
        If (Len(Dir(FILENAME)) > 0) Then
            ret = MsgBox("OverWrite. OK?", vbYesNo, "OverWrite")
            If (ret <> vbYes) Then
                Exit Function
            Else
                Err = 0
                On Error Resume Next
                Kill FILENAME
                On Error GoTo 0
                If (Err <> 0) Then
                    ret = MsgBox("OverWrite Error. File Opened? ", , "OverWriteError")
                    Exit Function
                End If
            End If
        End If
    End If
    
    Get_FileName = FILENAME

End Function