如何在没有引用的情况下在 vba 中打开 FileDialog（打开/保存）

Question

我正在使用一台在 Windows XP 上运行但没有安装 Office 或 .NET Framework 的机器。 我希望能够通过打开FileDialog 来打开/保存文件。不幸的是，它们没有（在 VBA 编辑器中）作为一个类列出。如何将它们放入我的代码中？

以下是我用来保存的示例（有效，但我确实需要文件对话框）。我以同样的方式实现打开文件：

Sub Make_File()

Dim i As Long
Dim AnzTrace As Long
Dim SysAbstand As Double
Dim DatName, Type, Dummy As String
Dim SysDist As Double
Dim Nr, Pos, Offset, Phase As Double
Dim SysDate, SysTime As String
Dim Buff1, Buff2, Buff3 As String
Dim Day, Time As Variant
Dim AktDir As String

AktDir = CurDir                                 

Call Shell("C:\WINDOWS\explorer " & AktDir, 1)  ' I need to change folder in file explorer in order to save the file where i want...

Message1 = "Dateinamen eingeben (ohne .txt)"   
Title = "Data Input"                            
Default1 = TXTDatName                           
DatName = InputBox(Message1, Title, Default1)   
If DatName = "" Then                         
    GoTo ExitMakeFile
End If

Message1 = "Kommentar eingeben"                  
Title = "Data Input"                              
Default1 = "bla bla bla"                    
Type = InputBox(Message1, Title, Default1) 
If Type = "" Then                        
    GoTo ExitMakeFile
End If


Message1 = "Systemabstand eingeben"            
Title = "Data Input"                           
Default1 = "116"                               
SysDist = InputBox(Message1, Title, Default1) 
If Dummy = Null Then                            
    GoTo ExitMakeFile
End If

Day = SCPI.SYSTem.Date                          
Buff1 = Format(Day(0), "####")                  
Buff2 = Format(Day(1), "0#")                    
Buff3 = Format(Day(2), "0#")                    
SysDate = Buff1 & "/" & Buff2 & "/" & Buff3     
Time = SCPI.SYSTem.Time                         
Buff1 = Format(Time(0), "0#")                   
Buff2 = Format(Time(1), "0#")                  
SysTime = Buff1 & ":" & Buff2                


AnzTrace = SCPI.CALCulate(1).PARameter.Count   
Dummy = " "                                    

DatName = AktDir & "\" & DatName & ".txt"       
i = AnzTrace                                   
Open DatName For Output As #1                  
Print #1, AntennaType                          
Print #1, "Datum: " & SysDate & " " & SysTime  

Buff1 = "X" & Chr(9) & "Abstand" & Chr(9) & "Kabel" & Chr(9) & "gedreht"
Print #1, Buff1                                 
Print #1, Dummy                                

Do While i > 1  
    Pos = SysDist
    Offset = 0
    Phase = 0
    Buff3 = Str(i) & Chr(9) & Str(Pos) & Chr(9) & Str(Offset) & Chr(9) & Str(Phase)
    Print #1, Buff3                          
    i = i - 1
Loop

Buff3 = Str(i) & Chr(9) & "  0" & Chr(9) & Str(Offset) & Chr(9) & Str(Phase)
Print #1, Buff3
Close #1                                       

Call Shell("C:\WINDOWS\notepad " & DatName, 1)

ExitMakeFile:
End Sub

Answer 1

所以基本上我必须在用户窗体中编写以下内容，然后创建一个名为“ReadFile”的按钮和一个名为“FileName”的字段。

Private Sub ReadFile_Click()

Dim tpOpenFname As ToFile
Dim lReturn As Long

Me.hide ' I hide the Userform but I can't really get a proper focus on the getOpenFile

With tpOpenFname
    .lpstrFile = String(257, 0)
    .nMaxFile = Len(tpOpenFname.lpstrFile)
    .lStructSize = Len(tpOpenFname)
    .lpstrFilter = "Text files (*.txt)"   ' I want only to open txt
    .nFilterIndex = 1
    .lpstrFileTitle = tpOpenFname.lpstrFile
    .nMaxFileTitle = tpOpenFname.nMaxFile
    .lpstrInitialDir = "C:\"
    .lpstrTitle = "Bitte eine Datei eingeben"
End With

lReturn = GetOpenFileName(tpOpenFname)

If lReturn = 0 Then
    End
Else
    Me.FileName = Left(tpOpenFname.lpstrFile, InStr(tpOpenFname.lpstrFile, ".txt") + 3) 
    'This is because I get silly symbols after the real filename (on "save" didn't have this problem though
End If

Me.Show

End Sub

在主模块中：

Read.Show vbModal ' to call the Userform
DatName = Read.FileName 'Read is the Userform name
Open DatName For Input As #1

至于“保存”：

Private Sub SaveFile_Click()

Dim tpSaveFname As ToFile
Dim lReturn As Long

Me.hide

With tpSaveFname
    .lpstrFile = String(257, 0)
    .nMaxFile = Len(tpSaveFname.lpstrFile)
    .lStructSize = Len(tpSaveFname)
    .lpstrFilter = "Text files (*.txt)"
    .nFilterIndex = 1
    .lpstrFileTitle = tpSaveFname.lpstrFile
    .nMaxFileTitle = tpSaveFname.nMaxFile
    .lpstrInitialDir = "C:\"
    .lpstrTitle = "Bitte eine Datei eingeben"
End With

lReturn = GetSaveFileName(tpSaveFname)

If lReturn = 0 Then
    End
Else
    Me.FileName = tpSaveFname.lpstrFile
    Me.FileName = Me.FileName & ".txt"
End If

Me.Show

End Sub

在主模块中：

DatName = SaveAs.FileName 'SaveAs is the Userform name
Call Shell("C:\WINDOWS\notepad " & DatName, 1)

Answer 2

这是改编自 msdn 示例。将其粘贴到标准模块中。

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenFilename As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenFilename As OPENFILENAME) 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

Sub EntryPoint()

    Dim tpOpenFname As OPENFILENAME

    With tpOpenFname
        .lpstrFile = String(256, 0)
        .nMaxFile = 255
        .lStructSize = Len(tpOpenFname)

        If GetOpenFileName(tpOpenFname) <> 0 Then
            Debug.Print Left$(.lpstrFile, .nMaxFile)
        Else
            Debug.Print "Open Canceled"
        End If

        If GetSaveFileName(tpOpenFname) <> 0 Then
            Debug.Print Left$(.lpstrFile, .nMaxFile)
        Else
            Debug.Print "Save Canceled"
        End If
    End With

End Sub