E
efandango
The code below will export the recordset data to a know filename and known
path.
I want to be able to have the user create the filename using a message box,
and then have the code incorporate that filename, add a .kml extenstion to
the filename and then export the recordset output to it.
If at all possible, I would love to be able to use the standard windows file
system dialog boxes, which would allow for a filename and the ability to
change paths. If not, I would gladly settle for just the dynamic filename
naming and export.
these are the lines that contains the pre-exisitng filename:
Open "W:\Folder\Addresses.kml" For Output As #lngFN
Dim stAppName As String
stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"
Call Shell(stAppName, 1)
here is my exisitng code
***********************
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strStartRun_No As String
Dim strEndRun_No As String
Dim FileTitle As String
' Dim strRun_No As String
Dim lngFN As Long
'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN
strStartRun_No = InputBox("Enter the lower Run No")
strEndRun_No = InputBox("Enter the higher Run No")
FileTitle = InputBox("Enter the file title")
If Len(strStartRun_No) > 0 Then
Set db = CurrentDb()
Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_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>" & FileTitle & "</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, "&", "and")
'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
*****************************
path.
I want to be able to have the user create the filename using a message box,
and then have the code incorporate that filename, add a .kml extenstion to
the filename and then export the recordset output to it.
If at all possible, I would love to be able to use the standard windows file
system dialog boxes, which would allow for a filename and the ability to
change paths. If not, I would gladly settle for just the dynamic filename
naming and export.
these are the lines that contains the pre-exisitng filename:
Open "W:\Folder\Addresses.kml" For Output As #lngFN
Dim stAppName As String
stAppName = "C:\Program Files\Google\Google Earth\GoogleEarth.exe
W:\Folder\Addresses.kml"
Call Shell(stAppName, 1)
here is my exisitng code
***********************
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strStartRun_No As String
Dim strEndRun_No As String
Dim FileTitle As String
' Dim strRun_No As String
Dim lngFN As Long
'Create empty text file
lngFN = FreeFile()
Open "W:\Folder\Addresses.kml" For Output As #lngFN
strStartRun_No = InputBox("Enter the lower Run No")
strEndRun_No = InputBox("Enter the higher Run No")
FileTitle = InputBox("Enter the file title")
If Len(strStartRun_No) > 0 Then
Set db = CurrentDb()
Set qdf = db.QueryDefs("Generate_KML_Run_Titles")
qdf.Parameters("StartRun") = strStartRun_No
qdf.Parameters("EndRun") = strEndRun_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>" & FileTitle & "</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, "&", "and")
'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
*****************************