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

Question

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

下面是我用来保存（它工作，但我真的需要filedialogs）的例子。我以同样的方式实现打开文件：

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的”按钮，一个名为“文件名”字段中。

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