[GIS] Excel macro to KML using VBA Loop

googlekmlvba

I am trying to write a VBA loop which will turn a list of addresses and their corresponding Lat Long coordinates in to a KML file for viewing in Google Earth.

I have managed to get the opening and closing KML tags in, but can't work out how to loop only the coordinates in to the coordinate tags, and have the addresses in their own tag. If anyone could lend a hand, I will be eternally in their debt! (Ultimately, I will want to have the following info in the KML File: Job Number, House Number + Street name (combined in KML Placemark tag, but from different Excel cells), City, Lat/Long. However, for my learning I currently have address and latlong.

A1: Addresses, B1: Lat, C1: Long

Current results:

"<?xml version=""1.0"" encoding=""UTF-8""?><kml xmlns=""http://earth.google.com/kml/2.2""><Document>"
"<coordinates>1892 Mccreary Road,49.950362,-97.0804002</coordinates>"
"<coordinates>38 Monarch Mews,49.948567,-97.0784119</coordinates>"
"<coordinates>3170 Vialoux Drive,49.9482365,-97.0775992</coordinates>"
"</Document></kml>"

Code:

Sub WriteTextFile()

Worksheets("Sheet1").Range("A1").Activate

Dim FilePath As String
Dim CellData As String
Dim LastCol As Long
Dim LastRow As Long
Dim CoordOpen As String
Dim CoordClose As String
Dim KMLCrap As String
Dim KMLCrapClose As String

Const HEADER As String = "<?xml version=""1.0"" encoding=""UTF-8""?><kml xmlns=""http://earth.google.com/kml/2.2"">" + ("<Document>")

LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

CellData = ""

FilePath = "C:\Users\TeamCK\Desktop\VBA To KML Org\Original Examples\Great Loop.txt"

Open FilePath For Output As #2

KMLCrap = ("<?xml version=""1.0"" encoding=""UTF-8""?>") + ("<kml xmlns=""http://earth.google.com/kml/2.2"">") + ("<Document>")

Write #2, KMLCrap

CoordOpen = "<coordinates>"
CoordClose = "</coordinates>"

    For I = 1 To LastRow
        For J = 1 To LastCol
            If J = LastCol Then
                CellData = CellData + Trim(ActiveCell(I, J).Value)
            Else
                CellData = CellData + Trim(ActiveCell(I, J).Value) + ","
            End If
        Next J
            Write #2, CoordOpen + CellData + CoordClose
            CellData = ""
    Next I

KMLCrapClose = ("</Document></kml>")
Write #2, KMLCrapClose

Close #2

MsgBox ("Done")

End Sub

Best Answer

I would stop what you are doing and have a look at the KML specifications as what you appear to be generating albeit wrong does not conform to KML standards. Have a look at this tutorial and study the structure, you don't appear to be enclosing it in a placemarker tag? So even if you get your address sorted it would be invalid KML.

Personally if this was me doing it I would build the KML as XMLDOM object and then write that out as a KML file...

Related Question