Parse Excel data to Google Earth Paths (LineString)

[Kestrel]

Hi All,
I am so close...
I have some VBA code which pulls Latitude and Longitude data and writes a KML file which then opens Google Earth and displays place marks.
I would like to add Paths or LineStrings but keep coming up with compile errors.


The "Public Function CreatePlacemark" section works just fine. This was existing code which I found on the internet, sample screenshot attached.

Sample.jpg


The "Public Function CreateLineString" is code i tried to add which results in a "Argument not Optional" error in "Public Sub CreateKML()"


Regards Paul

Option Explicit

Public Declare Function ShellExecute _
    Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

Private Function CleanString(DirtyString As String) As String
  Dim Str As String
  Dim i As Long
  Dim c As String
  Dim b As Long
  Str = DirtyString
  For i = 1 To Len(Str)
    c = Mid(Str, i, 1)
    b = Asc(c)
    Select Case b
      Case 32, 65 To 90, 97 To 122
      Case Else
        Str = Replace(Str, c, " ")
    End Select
  Next i
  Str = Replace(Str, "  ", " ")
  Str = Replace(Str, "  ", " ")
  Str = Replace(Str, "  ", " ")
  CleanString = Str
End Function

Public Function CreatePlacemark(PlaceName As String, Description As String, Longitude As Double, Latitude As Double) As String
  Dim Xml As String
  
  
  
  
  Xml = ""
  Xml = Xml & "  <Placemark>" & vbCrLf
  Xml = Xml & "    <description>{DESCRIPTION}</description>" & vbCrLf
  Xml = Xml & "    <name>{PLACE_NAME}</name>" & vbCrLf
  Xml = Xml & "    <View>" & vbCrLf
  Xml = Xml & "      <longitude>{LONGITUDE}</longitude>" & vbCrLf
  Xml = Xml & "      <latitude>{LATITUDE}</latitude>" & vbCrLf
  Xml = Xml & "      <range>{RANGE}</range>" & vbCrLf
  Xml = Xml & "      <tilt>{TILT}</tilt>" & vbCrLf
  Xml = Xml & "      <heading>{HEADING}</heading>" & vbCrLf
  Xml = Xml & "    </View>" & vbCrLf
  Xml = Xml & "    <visibility>1</visibility>" & vbCrLf
  Xml = Xml & "    <styleUrl>root://styleMaps#default?iconId=0x307</styleUrl>" & vbCrLf
  Xml = Xml & "    <Style>" & vbCrLf
  Xml = Xml & "      <icon></icon>" & vbCrLf
  Xml = Xml & "    </Style>" & vbCrLf
  Xml = Xml & "    <Point>" & vbCrLf
  Xml = Xml & "      <coordinates>{LONGITUDE},{LATITUDE}</coordinates>" & vbCrLf
  Xml = Xml & "    </Point>" & vbCrLf
  Xml = Xml & "  </Placemark>" & vbCrLf
  Xml = Replace(Xml, "{PLACE_NAME}", CleanString(PlaceName))
  Xml = Replace(Xml, "{DESCRIPTION}", CleanString(Description))
  Xml = Replace(Xml, "{LONGITUDE}", Longitude)
  Xml = Replace(Xml, "{LATITUDE}", Latitude)
  Xml = Replace(Xml, "{RANGE}", 141.4)
  Xml = Replace(Xml, "{TILT}", 0)
  Xml = Replace(Xml, "{HEADING}", 0)
  CreatePlacemark = Xml
End Function
Public Function CreateLineString(LineString As String, PlaceName As String, Description As String, Longitude As Double, Latitude As Double) As String
  Dim Xml As String
  
  
  
  
  Xml = ""
  Xml = Xml & "  <Placemark>" & vbCrLf
  Xml = Xml & "<name>Flight plan</name>"
  Xml = Xml & "      <description>Flight plan from Champagne PC Services Flight Planner 3000</description>"
  Xml = Xml & "    <styleUrl>#yellowLine</styleUrl>"
  Xml = Xml & " < Linestring > "
  Xml = Xml & "       <extrude>0</extrude>"
  Xml = Xml & "        <tessellate>1</tessellate>"
  Xml = Xml & "      <altitudeMode>clampToGround</altitudeMode>"
  Xml = Xml & "        <coordinates>"
  Xml = Xml & "      <coordinates>{LONGITUDE},{LATITUDE}</coordinates>" & vbCrLf
  Xml = Xml & "    </Linestring>" & vbCrLf
  Xml = Xml & "  </Placemark>" & vbCrLf
  Xml = Replace(Xml, "{PLACE_NAME}", CleanString(PlaceName))
  Xml = Replace(Xml, "{DESCRIPTION}", CleanString(Description))
  Xml = Replace(Xml, "{LONGITUDE}", Longitude)
  Xml = Replace(Xml, "{LATITUDE}", Latitude)
  Xml = Replace(Xml, "{RANGE}", 141.4)
  Xml = Replace(Xml, "{TILT}", 0)
  Xml = Replace(Xml, "{HEADING}", 0)
  CreateStringline = Xml
End Function


Public Sub CreateKML()
  Dim OutputPath As String, Filename As String
  Dim KMLName As String
  Dim PlaceName As String, Description As String
  Dim Longitude As Double, Latitude As Double
  Dim LineString As String
  Dim Xml As String
  Dim Sht As Excel.Worksheet
  Dim Rng As Excel.Range
  Dim Row As Long
  Dim Arr As Variant
  Dim f As Long
  Set Sht = ThisWorkbook.Worksheets("KML")
  Set Rng = Sht.Range("CoordData")
  OutputPath = Sht.Range("OutputPath").Value
  KMLName = Sht.Range("KMLName").Value
  Arr = Rng.Value
  Row = 2
  Xml = ""
  Xml = Xml & "<?xml version=""1.0"" encoding=""UTF-8""?>" & vbCrLf
  Xml = Xml & "<Folder>" & vbCrLf
  Xml = Xml & "  <name>{FOLDER_NAME}</name>" & vbCrLf
  Xml = Xml & "  <open>1</open>" & vbCrLf
  Xml = Replace(Xml, "{FOLDER_NAME}", KMLName)
  Do While Arr(Row, 1) <> ""
    PlaceName = Arr(Row, 1)
    Description = ""
    Latitude = Arr(Row, 2)
    Longitude = Arr(Row, 3)
    Xml = Xml & CreatePlacemark(PlaceName, Description, Longitude, Latitude)
    Xml = Xml & CreateLineString
    
    Row = Row + 1
  Loop
  Xml = Xml & "</Folder>" & vbCrLf
  Filename = OutputPath & "\" & KMLName & ".kml"
  On Error Resume Next
  Kill Filename
  On Error GoTo 0
  f = FreeFile
  Open Filename For Binary As #f
  Put #f, , Xml
  Close #f
  LaunchAssociatedFile Filename
End Sub

Public Function RangeAddress(Row1 As Long, Col1 As Long, Row2 As Long, Col2 As Long) As String
  RangeAddress = CellAddress(Row1, Col1) & ":" & CellAddress(Row2, Col2)
End Function

Public Function CellAddress(Row As Long, Col As Long) As String
  Dim ColBlock As Long
  Dim ColChar As Long
  Dim txt As String
  ColBlock = Int((Col - 1) / 26)
  ColChar = (Col - 1) Mod 26 + 1
  If ColBlock > 0 Then
    txt = Chr$(64 + ColBlock)
  End If
  txt = txt & Chr$(64 + ColChar)
  CellAddress = txt & Row
End Function

Sub LaunchAssociatedFile(Filename As String)
    Dim strAction As String
    Dim lngErr As Long
    strAction = "OPEN"  ' action might be OPEN, NEW or other, depending on what you need to do
    lngErr = ShellExecute(0, strAction, Filename, "", "", 0)
End Sub