filedlgs.bas

来自「使用WebBrowser控件作为容器打开Word文档 === === === 」· BAS 代码 · 共 88 行

Attribute VB_Name = "FileDlgs"

Option Explicit
' FileDlgs (Vb6) Feb, 2006  contact [e-mail]
' Common dialog file routines
' Requires Project/References to "Microsoft Dialog Automation Objects" (DlgObjs.dll)
'   (If not shown in list, use "Browse"; may be in "PDWizard" directory)
'   DlgObjs.dll is essentially a library version of the Common Dialog Control.
'===================================================================================
Private Const SLOSH = "\"

Public Function GetOpenFileName( _
                    StartDir As String, _
                    ParamArray Masks() As Variant) As String

    On Error GoTo GetOpenFileName_Error
    
    Dim Result As String        ' Default function result = ""
    Dim Dlg As DialogObjects.ChooseFile
    Dim RestoreCurDir As String ' Restore current dir on exit
    Dim Filter As Variant
    
    RestoreCurDir = CurDir
    Set Dlg = New DialogObjects.ChooseFile
    With Dlg
        If Len(StartDir) Then .Directory = StartDir
        For Each Filter In Masks
            .Filters.Add Filter
        Next
        .Center = True
        .FileMustExist = True
        .HideReadOnly = False
        .Show
        If Len(.FileName) Then Result = .Directory & SLOSH & .FileName
    End With
    
GetOpenFileName_Exit:
    Set Dlg = Nothing
    ChDir RestoreCurDir
    GetOpenFileName = Result
    Exit Function
    
GetOpenFileName_Error:
    MsgBox Err.Message & " - " & Err.Description, vbExclamation, "GetOpenFileName"
    Resume GetOpenFileName_Exit
    
End Function

Public Function GetSaveAsFileName( _
                    DefaultFileName As String, _
                    StartDir As String, _
                    ParamArray Masks() As Variant) As String

    On Error GoTo GetSaveAsFileName_Error
    
    Dim Result As String        ' Default function result = ""
    Dim Dlg As DialogObjects.ChooseFile
    Dim RestoreCurDir As String ' Restore current dir on exit
    Dim Filter As Variant
    
    RestoreCurDir = CurDir
    Set Dlg = New DialogObjects.ChooseFile
    With Dlg
        If Len(StartDir) Then .Directory = StartDir
        For Each Filter In Masks
            .Filters.Add Filter
        Next
        .FileName = DefaultFileName
        .Center = True
        .Save = True
        .OverwritePrompt = True
        .HideReadOnly = True
        .Show
        If Len(.FileName) Then Result = .Directory & SLOSH & .FileName
    End With
    
GetSaveAsFileName_Exit:
    Set Dlg = Nothing
    ChDir RestoreCurDir
    GetSaveAsFileName = Result
    Exit Function
    
GetSaveAsFileName_Error:
    MsgBox Err.Message & " - " & Err.Description, vbExclamation, "GetSaveAsFileName"
    Resume GetSaveAsFileName_Exit
    
End Function