2013-08-06 50 views
2

我正在使用在Windows XP上運行但未安裝Office或.NET Framework的計算機。 我想通過打開FileDialog來打開/保存文件。不幸的是,他們沒有列出(在VBA編輯器中)作爲一個類。我如何將它們放入我的代碼中?如何在沒有引用的情況下在vba中打開FileDialog(打開/保存)

下面是我用來保存(它工作,但我真的需要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 
+0

的http://支持.microsoft.com/kb/161286 – dee

+0

如果沒有Office,什麼主機VB你正在使用的環境? –

+0

你在哪裏使用VBA? –

回答

0

所以基本上我不得不寫在用戶窗體以下內容,然後創建一個名爲「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) 
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 
+0

看起來不錯,非常感謝。我是否也可以要求相同的「另存爲...」文件對話框? – Noldor130884

+0

我更新了代碼以包含GetSaveFileName。 –

+0

所以...我很抱歉拖延,但我正在度假。我試過你的代碼,它似乎沒有辦法。文件無法打開或保存。我會在開始時添加一些代碼,以使您更好地理解使用它來使其工作。 – Noldor130884

相關問題