Solved: getting lat/lon coordinates out of Google Earth and into Excel

[xltrader100]

The data for a Google Earth Placemark includes it's Lat/Lon coordinates, but it's surprisingly difficult to get these coordinates onto the clipboard so I can bring them into Excel. It's possible to do it with a multi step process using the Get Info Box for the Placemark, but I need to do hundreds of these things so it has to be one step.

One way that seems promising is to right click on the Placemark and Copy. This puts 56 lines of tab-indented html onto the clipboard (copy attached), and in the middle of this mess are the numbers I'm trying to extract. These show up as:
<longitude>-123.4501624997986</longitude>
<latitude>48.76901200133714</latitude>

So, one possible route would be to add a new sheet, paste in the html, parse it to extract the lat/lon, put these numbers back on the clipboard as "Lat,Lon" and then delete the new sheet. Could somebody help me out with some VBA magic to make that happen? Or something like it?

[Paul_Hossler]

I was thinking that if you already copied it to the clipboard as theXML in your sample, you could just pull it out of the clipboard with a macro and put it in a spreadsheet cell or us it in a macr0


Option Explicit
'Tools, References, Forms Library
Sub TestSplit()
Dim DataObj As New MSForms.DataObject
Dim sGoogle As String
Dim vXML As Variant
Dim i As Long
Dim dLat As Double, dLong As Double

DataObj.GetFromClipboard
sGoogle = DataObj.GetText

vXML = XML_Parse(sGoogle)
For i = LBound(vXML) To UBound(vXML)

If LCase(Application.WorksheetFunction.Clean(vXML(i))) = "<latitude>" Then
dLat = CDbl(vXML(i + 1))
ElseIf LCase(Application.WorksheetFunction.Clean(vXML(i))) = "<longitude>" Then
dLong = CDbl(vXML(i + 1))
End If
Next i
MsgBox "Lat = " & dLat
MsgBox "Long = " & dLong
End Sub

Function XML_Parse(sXML As String) As Variant
Dim sInput As String
Dim v As Variant

sInput = sXML
sInput = Replace(sInput, "><", Chr(1))
sInput = Replace(sInput, "</", Chr(2))
sInput = Replace(sInput, ">", Chr(3))
sInput = Replace(sInput, Chr(1), ">" & Chr(1) & "<")
sInput = Replace(sInput, Chr(2), Chr(1) & "</")
sInput = Replace(sInput, Chr(3), ">" & Chr(1))

sInput = Left(sInput, Len(sInput) - 1)

v = Split(sInput, Chr(1))

XML_Parse = v
End Function


Paul

[xltrader100]

Thanks Paul, that works great, and much cleaner than adding sheets. Just for completeness, I finished putting the lat/lon back on the clipboard, which was my original goal.

Option Explicit 'Tools, References, Forms Library

Sub TestSplit()
Dim DataObj As New MSForms.DataObject
Dim sGoogle As String
Dim vXML
Dim i As Long
Dim dLat As Double, dLong As Double

DataObj.GetFromClipboard
sGoogle = DataObj.GetText

vXML = XML_Parse(sGoogle)
For i = LBound(vXML) To UBound(vXML)
If LCase(Application.WorksheetFunction.Clean(vXML(i))) = "<latitude>" Then
dLat = CDbl(vXML(i + 1))
ElseIf LCase(Application.WorksheetFunction.Clean(vXML(i))) = "<longitude>" Then
dLong = CDbl(vXML(i + 1))
End If
Next i

Dim clipText as string
clipText = dLat & "," & dLong
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText clipText
MyData.PutInClipboard
End Sub

Function XML_Parse(sXML As String)
Dim sInput As String
sInput = sXML
sInput = Replace(sInput, "><", Chr(1))
sInput = Replace(sInput, "</", Chr(2))
sInput = Replace(sInput, ">", Chr(3))
sInput = Replace(sInput, Chr(1), ">" & Chr(1) & "<")
sInput = Replace(sInput, Chr(2), Chr(1) & "</")
sInput = Replace(sInput, Chr(3), ">" & Chr(1))
sInput = Left(sInput, Len(sInput) - 1)
Dim v
v = Split(sInput, Chr(1))
XML_Parse = v
End Function

[Kenneth Hobs]

Of course you could get the source code by a winhttp method easily enough. e.g. http://www.vbaexpress.com/forum/showthread.php?t=26305

Here is something that I had worked up for mid string parsing.
Sub Test_MidStr()
Dim s As String
s = "First Line" & vbCrLf & _
"<longitude>-123.4501624997986</longitude>" & vbCrLf & _
"<latitude>48.76901200133714</latitude>" & vbCrLf & _
"Last Line"
MsgBox MidStr(s, "<longitude>", "</longitude>")
MsgBox MidStr(s, "<latitude>", "</latitude>")
End Sub


'Finds mid string from sTo and then back to sFrom. So, make sTo unique.
Function MidStr(str As String, sFrom As String, sTo As String, Optional toOffset As Integer = 0) As String
Dim strSub As String, sBegPos As Long, sEndPos As Long

sEndPos = InStr(str, sTo) - toOffset - 1
strSub = Left(str, sEndPos)
sBegPos = InStrRev(strSub, sFrom)

MidStr = Mid(strSub, sBegPos + Len(sFrom), sEndPos - sBegPos)
End Function

[xltrader100]

Thanks, Ken. That streamlines it. So, this is what I wound up with.

Option Explicit 'Tools, References, Forms Library

'parse the Placemark XML data on the clipboard and extract lat/lng back to clipboard
Sub googleLatLngToClip()
Dim DataObj As New MSForms.DataObject
Dim sGoogle As String
Dim dLat As Double, dLong As Double
DataObj.GetFromClipboard
sGoogle = DataObj.GetText
dLat = MidStr(sGoogle, "<latitude>", "</latitude>")
dLong = MidStr(sGoogle, "<longitude>", "</longitude>")

Dim clipText As String
clipText = dLat & "," & dLong
Dim MyData As DataObject
Set MyData = New DataObject
MyData.SetText clipText
MyData.PutInClipboard
End Sub

'Finds mid string from sTo and then back to sFrom. So, make sTo unique.
Function MidStr(str As String, sFrom As String, sTo As String, Optional toOffset As Integer = 0) As String
Dim strSub As String, sBegPos As Long, sEndPos As Long
sEndPos = InStr(str, sTo) - toOffset - 1
strSub = Left(str, sEndPos)
sBegPos = InStrRev(strSub, sFrom)
MidStr = Mid(strSub, sBegPos + Len(sFrom), sEndPos - sBegPos)
End Function