GeoCoding in Word via UserForm

[JamesHayek]

Hello All,

I have a UserForm that populates data and replaces all Bookmarks and References with what the user inputs. I would love to take the address from the input box and use it to find the Lat and Log coords and populate that in a bookmark made on the Word Document.

I have found someones GeoCoding code in Excel and it outputs to the cell to the right of where the address is entered.

How can I assign this value to a bookmark on my document?

Any help is much appreciated.

The code I found is as follows:

Option Explicit


Function GetCoordinates(Address As String) As String
    
    '-----------------------------------------------------------------------------------------------------
    'This function returns the latitude and longitude of a given address using the Google Geocoding API.
    'The function uses the "simplest" form of Google Geocoding API (sending only the address parameter),
    'so, optional parameters such as bounds, key, language, region and components are NOT used.
    'In case of multiple results (for example two cities sharing the same name), the function
    'returns the FIRST OCCURRENCE, so be careful in the input address (tip: use the city name and the
    'postal code if they are available).
    
    'NOTE: As Google points out, the use of the Google Geocoding API is subject to a limit of 2500
    'requests per day, so be careful not to exceed this limit.
    
    'In order to use this function you must enable the XML, v3.0 library from VBA editor:
    'Go to Tools -> References -> check the Microsoft XML, v3.0.
    
    'Written by:    Christos Samaras
    'Date:          12/06/2014

    '-----------------------------------------------------------------------------------------------------
    
    'Declaring the necessary variables. Using 30 at the first two variables because it
    'corresponds to the "Microsoft XML, v3.0" library in VBA (msxml3.dll).
    Dim Request         As New XMLHTTP30
    Dim Results         As New DOMDocument30
    Dim StatusNode      As IXMLDOMNode
    Dim LatitudeNode    As IXMLDOMNode
    Dim LongitudeNode   As IXMLDOMNode
            
    On Error GoTo errorHandler
    
    'Create the request based on Google Geocoding API. Parameters (from Google page):
    '- Address: The address that you want to geocode.
    '- Sensor: Indicates whether your application used a sensor to determine the user's location.
    'This parameter is no longer required.
    Request.Open " SOME URL HERE"      <~~~I cant post the GeoCoding URL due to site limitations on this Forum
    & "&address=" & Address & "&sensor=false", False
            
    'Send the request to the Google server.
    Request.send
    
    'Read the results from the request.
    Results.LoadXML Request.responseText
    
    'Get the status node value.
    Set StatusNode = Results.SelectSingleNode("//status")
    
    'Based on the status node result, proceed accordingly.
    Select Case UCase(StatusNode.Text)
    
        Case "OK"   'The API request was successful. At least one geocode was returned.
            
            'Get the latitdue and longitude node values of the first geocode.
            Set LatitudeNode = Results.SelectSingleNode("//result/geometry/location/lat")
            Set LongitudeNode = Results.SelectSingleNode("//result/geometry/location/lng")
            
            'Return the coordinates as string (latitude, longitude).
            GetCoordinates = LatitudeNode.Text & ", " & LongitudeNode.Text
        
        Case "ZERO_RESULTS"   'The geocode was successful but returned no results.
            GetCoordinates = "The address probably not exists"
            
        Case "OVER_QUERY_LIMIT" 'The requestor has exceeded the limit of 2500 request/day.
            GetCoordinates = "Requestor has exceeded the server limit"
            
        Case "REQUEST_DENIED"   'The API did not complete the request.
            GetCoordinates = "Server denied the request"
            
        Case "INVALID_REQUEST"  'The API request is empty or is malformed.
            GetCoordinates = "Request was empty or malformed"
        
        Case "UNKNOWN_ERROR"    'Indicates that the request could not be processed due to a server error.
            GetCoordinates = "Unknown error"
        
        Case Else   'Just in case...
            GetCoordinates = "Error"
        
    End Select
        
    'In case of error, release the objects.
errorHandler:
    Set StatusNode = Nothing
    Set LatitudeNode = Nothing
    Set LongitudeNode = Nothing
    Set Results = Nothing
    Set Request = Nothing
    
End Function


'--------------------------------------------------------------------------
'The next two functions using the GetCoordinates function in order to get
'the latitude and the longitude correspondingly of a given address.
'--------------------------------------------------------------------------


Function GetLatidue(Address As String) As Double


    Dim Coordinates As String
    
    'Get the coordinates for the given address.
    Coordinates = GetCoordinates(Address)
    
    'Return the latitude as number (double).
    If Coordinates <> "" Then
        GetLatidue = CDbl(Left(Coordinates, WorksheetFunction.Find(",", Coordinates) - 1))
    End If


End Function


Function GetLongitude(Address As String) As Double


    Dim Coordinates As String
    
    'Get the coordinates for the given address.
    Coordinates = GetCoordinates(Address)
    
    'Return the longitude as number (double).
    If Coordinates <> "" Then
        GetLongitude = CDbl(Right(Coordinates, Len(Coordinates) - WorksheetFunction.Find(",", Coordinates)))
    End If
    
End Function

My Userform code (as a snippit) is as follows:

    'Location Address
    Dim locationAddress As Range
    Set locationAddress = ActiveDocument.Bookmarks("Address").Range
    locationAddress.Text = Me.TextBox4.Value
    ActiveDocument.Bookmarks.Add "Address", locationAddress

[gmaxey]

Document needs a bookmark named Lat and a bookmark names Long

Userform Code (form needs a textbox for entering address and a command button.

Option Explicit
Private Sub CommandButton1_Click()
Dim Data As GoogleMapCoordinates
Dim oRng As Word.Range
  Data = fcnGoogleMapQuerry(TextBox1)
  If Data.Valid Then
    With ActiveDocument
      Set oRng = .Bookmarks("Lat").Range
      oRng.Text = Data.Lat
      .Bookmarks.Add "Lat", oRng
      Set oRng = .Bookmarks("Long").Range
      oRng.Text = Data.Longitude
      .Bookmarks.Add "Long", oRng
    End With
  End If
  Hide
lbl_Exit:
  Exit Sub
End Sub

Standard Module Code:

Option Explicit
Public Type GoogleMapCoordinates
  Valid As Boolean
  ErrorDesc As String
  Lat As String
  Longitude As String
End Type

Sub CallForm()
  UserForm1.Show
End Sub
Function fcnGoogleMapQuerry(ByVal strAddress) As GoogleMapCoordinates
'Requests and processes XML generated by Google Maps.
Dim strURL As String
Dim oXMLHttp As Object
Dim oDOMDocument As Object
Dim oNode As Object
  On Error GoTo err_Invalid
  Set oXMLHttp = CreateObject("MSXML2.XMLHTTP")
  Set oDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")
  'Pass address continous string e.g. 123 Maple Street Hamilton OH 45013
  strAddress = Replace(strAddress, " ", "+")
  strURL = "https://maps.googleapis.com/maps/api...de/xml?address=" & strAddress
  With oXMLHttp
    .Open "GET", strURL, False
    .setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
    .Send
    oDOMDocument.LoadXML .ResponseText
  End With
  
  With oDOMDocument
    If .SelectSingleNode("//status").Text = "OK" Then
      'Get GoogleMapCoordinates
      fcnGoogleMapQuerry.Lat = .SelectSingleNode("/GeocodeResponse[1]/result[1]/geometry[1]/location[1]/lat[1]").Text
      fcnGoogleMapQuerry.Longitude = .SelectSingleNode("/GeocodeResponse[1]/result[1]/geometry[1]/location[1]/lng[1]").Text
    Else
      fcnGoogleMapQuerry.ErrorDesc = .SelectSingleNode("//status").Text
      GoTo err_Invalid
    End If
  End With
  fcnGoogleMapQuerry.Valid = True
lbl_Exit:
  Set oDOMDocument = Nothing: Set oXMLHttp = Nothing: Set oNode = Nothing
  Exit Function
err_Invalid:
  If fcnGoogleMapQuerry.ErrorDesc = "" Then fcnGoogleMapQuerry.ErrorDesc = Err.Description
  fcnGoogleMapQuerry.Valid = False
  Resume lbl_Exit
End Function