سؤال

I'm working on a machine which runs on Windows XP but has no Office or .NET Framework installed. I would like to have the possibility to open/save files by opening a FileDialog. Unfortunately they are not listed (in VBA editor) as a Class. How do I get to put them in my code?

The following is an example of what I use to Save (which works, but I really need filedialogs). I achieve opening files in the same way:

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
هل كانت مفيدة؟

المحلول 2

So basically I had to write the following in a Userform, then create a button named "ReadFile" and a field called "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

And in the main module:

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

As for "Save":

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

And in the main module:

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

نصائح أخرى

This is adapted from the msdn example. Paste it in a standard module.

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
مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top