Hi all- I got this code off of a blog. What I want to do is make a .KML file based on the "address" field in the table "GoogleEarth". I do not understand, however, how to get this code to work for my needs.
the first error I come across is that it tells me the script needs a End Sub to it. When I add the End Sub at the end of the code it still fails with the same error.
and even where to put this code? behind a button on a form?
Thanks for any help.
the first error I come across is that it tells me the script needs a End Sub to it. When I add the End Sub at the end of the code it still fails with the same error.
and even where to put this code? behind a button on a form?
Thanks for any help.
Code:
[COLOR=#333333][FONT=Courier New]Option Compare Database[/FONT][/COLOR]
[FONT=Courier New][COLOR=#333333]Function XMLAttributeOutputToFile()[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Dim MyDB As Database[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Dim MyRS As Recordset[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Dim fld As Field[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Dim strText As String[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Dim MyTableName As String[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Dim QryOrTblDef As String[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]QryOrTblDef = "toKML"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Set MyDB = CurrentDb[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Set MyRS = MyDB.OpenRecordset(QryOrTblDef)[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Open "C:\" & QryOrTblDef & ".kml" For Output Shared As #1[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Print #1, "<?xml version=""1.0"" encoding=""UTF-8""?>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Print #1, "<kml xmlns=""http://earth.google.com/kml/2.1"">"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Print #1, "<Document>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]With MyRS[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Do Until .EOF[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] Print #1, " <Placemark>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] Print #1, " <Point>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] strText = " <coordinates>" & MyRS.Fields(0) & "," & ...[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] MyRS.Fields(1) & "</coordinates>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] Print #1, strText[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] Print #1, " </Point>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] Print #1, " </Placemark>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333] .MoveNext[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Loop[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]End With[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Print #1, "</Document>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Print #1, "</kml>"[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Egress:[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]On Error Resume Next[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Close #1[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]MyRS.Close[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Set MyRS = Nothing[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Set MyDB = Nothing[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Exit Function[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]ErrHandler:[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]MsgBox Err.Description[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]Resume Egress[/COLOR][/FONT]
[FONT=Courier New][COLOR=#333333]End Function[/COLOR][/FONT]
Last edited: