Distance calculation using latitude and longitude in MS access VBA

This article is an extension of article on Geocoding. This article will help to understand basic concept behind GPS system and its other counterparts like Russian GLONASS System and Indian IRNSS.In order to calculate distance between two different geographical sites we will use their Latitude and Longitude Co-ordinates. As shown in screen below to complete this article. First create a table (tblGeoCoding) along with few fields.

Latitude/Longitude distance calculator using Microsoft Access Fig 1.1


Now in next step create a simple form (frmFatchData) , As shown in screen below form will also contain a subform (Bounded to table created above) and a Button (with Caption Fetch Coordinates).

Latitude/Longitude distance calculator using Microsoft Access Fig 1.2


As shown in above figure, there is a separate section to calculate distance between two points using source and target latitude and longitude. Distance will be calculated in Kilometres (KM) and Nautical miles (NM).

To calculate latitude and Longitude of a particular geographical location, first user needs to fill following information as shown in screen below.

Latitude/Longitude distance calculator using Microsoft Access Fig 1.3


After filling all above details user needs to click on Fetch Coordinate Button. As result will be captured into remaining half of above screen. Now to calculate distance between two location use source (latitude, longitude) and target (latitude, longitude). After entering these values use Distance Calculation button to calculate distance (screen shown below).

Latitude/Longitude distance calculator using Microsoft Access Fig 1.4


VBA Code:-

Code associated with On Click event of Distance CalculationButton.

Private Sub CmdCalcDist_Click()
Dim theta, dist, lon1, lon2, lat1, lat2
lon1 = Me.TxtSrcLong
lon2 = Me.TxttarLong
lat1 = Me.txtSrclat
lat2 = Me.TxttarLat
theta = lon1 - lon2
dist = Sin(deg2rad(lat1)) * Sin(deg2rad(lat2)) + Cos(deg2rad(lat1)) * Cos(deg2rad(lat2)) * Cos(deg2rad(theta))
dist = acos(dist)
dist = rad2deg(dist)
dist = dist * 60 * 1.1515
Select Case Me.CmbUnit
Case "KM"
dist = dist * 1.609344
Case "NM"
dist = dist * 0.8684
End Select
Me.TxtDist = Round(dist, 2)
End Sub
Function acos(Rad)
If Abs(Rad) <> 1 Then
acos = Pi / 2 - Atn(Rad / Sqr(1 - Rad * Rad))
ElseIf Rad = -1 Then
acos = Pi
End If
End Function
Function deg2rad(Deg)
deg2rad = CDbl(Deg * Pi / 180)
End Function
Function rad2deg(Rad)
rad2deg = CDbl(Rad * 180 / Pi)
End Function

VBA Code:-

Code associated with On Click event of Fetch Coordinate Button.

Private Sub fatchCoordinates_Click()
Dim tGeoObj As tGeocodeAddressResult, rst As Recordset
DoCmd.Hourglass True
If DCount("ID", "tblGeoCoding") = 0 Then
MsgBox "Enter Address to Calculate latitude and longitude", vbInformation, "information"
DoCmd.Hourglass False
Exit Sub
End If
Set rst = CurrentDb.OpenRecordset("Select * from tblGeoCoding")
While Not rst.EOF
tGeoObj = GeocodeAddress(rst!Address, , rst!zip, rst!State, rst!Country)
With tGeoObj
rst!Latitude = .dLatitude
rst!Longitude = .dLongitude
rst!Accuracy = .sAccuracy
rst!status = .sStatus
End With
DoCmd.Hourglass False
End Sub

We have created a Module named MdlGeoCoding. This module composed of main functionality to enriching description of a given location.

Public Type tGeocodeAddressResult
dLatitude As Double
dLongitude As Double
sRetAddress As String
sAccuracy As String
sStatus As String
End Type
Public Function GeocodeAddress(Optional ByVal vAddress As Variant = Null, Optional ByVal vTown As Variant = Null, Optional ByVal vPostCode As Variant = Null, Optional ByVal vRegion As Variant = Null, Optional ByVal sCountry As String) As tGeocodeAddressResult
On Error GoTo ErrHndlr
Dim oXmlDoc As Object
Dim strUrl As String, sFormatAddress As String
If Not IsNull(vAddress) Then vAddress = Replace(vAddress, ",", " ")
sFormatAddress = (vAddress + ",") & (vTown + ",") & (vRegion + ",") & (vPostCode + ",") & sCountry
strUrl = "http://maps.googleapis.com/maps/api/geocode/xml?address=" & sFormatAddress & "&sensor=false"
Set oXmlDoc = CreateObject("Microsoft.XMLDOM")
With oXmlDoc
.async = False
If .Load(strUrl) And Not .selectSingleNode ("GeocodeResponse/status") Is Nothing Then
GeocodeAddress.sStatus = .selectSingleNode ("GeocodeResponse/status").Text
If Not .selectSingleNode ("GeocodeResponse/result") Is Nothing Then
GeocodeAddress.sRetAddress = .selectSingleNode ("//formatted_address").Text
GeocodeAddress.sAccuracy = .selectSingleNode ("//location_type").Text
GeocodeAddress.dLatitude = Val(.selectSingleNode("//location/lat").Text)
GeocodeAddress.dLongitude = Val(.selectSingleNode("//location/lng").Text)
End If
End If
End With
Set oXmlDoc = Nothing
Exit Function
Set oXmlDoc = Nothing
Err.Raise Err.Number, , Err.Description
End Function


It is advised that the information provided in the article should not be used for any kind formal or production programming purposes as content of the article may not be complete or well tested. ERP Makers will not be responsible for any kind of damage (monetary, time, personal or any other type) which may take place because of the usage of the content in the article.