E
efandango
I have some code which outputs records based on a single [Run_No]. I now want
to output a range using 'Between [Run No] And [Run Nos]' from the query. How
do I adjust the following code to accomodate the range of numbers, instead of
just one Run No?
the code:
**********************************
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strRun_No As String
Dim lngFN As Long
'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN
strRun_No = InputBox("Enter the Run No")
If Len(strRun_No) > 0 Then
Set db = CurrentDb()
Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("Run No") = strRun_No
qdf![Run No] = strRun_No
'Output header
'NB: need to double quotes in literal strings
Print #lngFN, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #lngFN, "<kml xmlns=""http://earth.google.com/kml/2.0"">"
Print #lngFN, "<Document>"
Print #lngFN, "<name>Run Points " & strRun_No & "</name>"
Print #lngFN, "<Folder>"
'Print #lngFN, "<name>Locations</name>"
Print #lngFN, "<open>1</open>"
Set rs = qdf.OpenRecordset(dbOpenSnapshot)
Do Until rs.EOF = True
'Print #lngFN, rs.Fields("KML_Address")
Dim strWork As String
strWork = rs.Fields("KML_Address")
strWork = Replace(strWork, "&", "&")
strWork = Replace(strWork, "'", "'")
'strWork = Replace(strWork, "<", "<")
Print #lngFN, strWork
rs.MoveNext
Loop
rs.Close
'Output footer
Print #lngFN, "</Folder>"
Print #lngFN, "</Document>"
Print #lngFN, "</kml>"
Close #lngFN
End If
On Error GoTo Err_Google_Earth_Points_Click
Dim stAppName As String
stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"
Call Shell(stAppName, 1)
Exit_Google_Earth_Points_Click:
Exit Sub
Err_Google_Earth_Points_Click:
MsgBox Err.Description
Resume Exit_Google_Earth_Points_Click
**********************************
to output a range using 'Between [Run No] And [Run Nos]' from the query. How
do I adjust the following code to accomodate the range of numbers, instead of
just one Run No?
the code:
**********************************
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strRun_No As String
Dim lngFN As Long
'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN
strRun_No = InputBox("Enter the Run No")
If Len(strRun_No) > 0 Then
Set db = CurrentDb()
Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("Run No") = strRun_No
qdf![Run No] = strRun_No
'Output header
'NB: need to double quotes in literal strings
Print #lngFN, "<?xml version=""1.0"" encoding=""UTF-8""?>"
Print #lngFN, "<kml xmlns=""http://earth.google.com/kml/2.0"">"
Print #lngFN, "<Document>"
Print #lngFN, "<name>Run Points " & strRun_No & "</name>"
Print #lngFN, "<Folder>"
'Print #lngFN, "<name>Locations</name>"
Print #lngFN, "<open>1</open>"
Set rs = qdf.OpenRecordset(dbOpenSnapshot)
Do Until rs.EOF = True
'Print #lngFN, rs.Fields("KML_Address")
Dim strWork As String
strWork = rs.Fields("KML_Address")
strWork = Replace(strWork, "&", "&")
strWork = Replace(strWork, "'", "'")
'strWork = Replace(strWork, "<", "<")
Print #lngFN, strWork
rs.MoveNext
Loop
rs.Close
'Output footer
Print #lngFN, "</Folder>"
Print #lngFN, "</Document>"
Print #lngFN, "</kml>"
Close #lngFN
End If
On Error GoTo Err_Google_Earth_Points_Click
Dim stAppName As String
stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"
Call Shell(stAppName, 1)
Exit_Google_Earth_Points_Click:
Exit Sub
Err_Google_Earth_Points_Click:
MsgBox Err.Description
Resume Exit_Google_Earth_Points_Click
**********************************