How to open FileDialog ( open / save ) in vba without references

Question

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

If there is no Office, what host VBA environment are you using? — Alex K., Aug 06 '13 at 12:57
On a network analyzer. Have no idea of the environment but it has quite the same GUI as Excel's. @ Daniel: your link doesn't explain much. I still don't understand where to put the code (why do I have to put it in a Form?), and it seems that I can't use Save but only Open — Noldor130884, Aug 06 '13 at 13:02

Dick Kusleika · Answer 1 · 2013-08-07T14:18:05.880

3

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

edited Aug 07 '13 at 14:18

answered Aug 06 '13 at 16:20

Dick Kusleika

32,673
4
52
73

Looks great, many thanks. Can I also ask the same for a "Save as..." File Dialog? – Noldor130884 Aug 07 '13 at 06:00
So... I'm sorry for the delay but I was on holiday. I tried your code and it doesn't somehow seem to work. Files won't open or be saved. I'll add some code at the beginning to make you better understand what I'm using to make it work. – Noldor130884 Sep 02 '13 at 07:11
1

GetOpenFileName and GetSaveFileName don't actually open or save files. They only get the Name of the file that you can then use in your own open or save code. – Dick Kusleika Sep 03 '13 at 13:30
Thanks for explaining me that, but in fact as I explained, I really needed to save and open files. Anyway you did help me a lot. Thanks – Noldor130884 Sep 04 '13 at 06:56
Six years later when I tried this under Windows 7, .lpstrFile was padded with lots of null characters at the end which I had to remove. – Loring Nov 07 '19 at 16:32

score 0 · Accepted Answer · answered Sep 02 '13 at 12:40

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)

How to open FileDialog ( open / save ) in vba without references

2 Answers2