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

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

Answer 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

Answer 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)