Here's the code with indenting and code tags:
Code:
Option Compare DatabaseOption Explicit
Dim Msg As String
Dim sglSectionLength As Single
Dim rstNode As adodb.Recordset
Dim rstSection As adodb.Recordset
Dim sglEastDiff As Single
Dim sglNorthDiff As Single
Dim lngGrid(2, 3) As Long
'First index 1=EndA, 2=EndB
'Second index 1=EndID,2=Easting, 3= Northing
Sub OpenTables()
'open tblNode
Set rstNode = New adodb.Recordset
rstNode.ActiveConnection = CurrentProject.Connection
rstNode.CursorType = adOpenDynamic
rstNode.Open Source:="tblNode"
'Open tblSection
Set rstSection = New adodb.Recordset
rstSection.ActiveConnection = CurrentProject.Connection
rstSection.CursorType = adOpenDynamic
rstSection.Open Source:="tblSection"
Call SectionLength
'close both tables
rstSection.Close
Set rstSection = Nothing
rstNode.Close
Set rstNode = Nothing
End Sub
Sub SectionLength()
'Riffle through all the section records one at a time from first to last and
'read the NodeIDs of the two ends of any records which show zero length.
rstSection.MoveFirst
'This repeats through all the secton records
Do Until rstSection.EOF
'This skips over the sectons that aleady show their length
If rstSection!SectionLength = 0 Then
'There is a need to calclate this section length
'First, read the node IDs at the A and B section ends
lngGrid(1, 1) = rstSection!nodeA
Msg = "ID of NodeA: " & Str(lngGrid(1, 1))
MsgBox Msg
lngGrid(2, 1) = rstSection!nodeB
Msg = "ID of NodeB " & Str(lngGrid(2, 1))
MsgBox Msg
'MapRefs reads eastings and northings of NodA and NodeB
Call MapRefs
Call Pythag
End If
rstSection.MoveNext
Loop
End Sub 'This is the end of the core Sub SectionLength
Sub MapRefs()
'Grid references held in an array lngGrid(End,Ref)
'where End may be: 1=EndA or 2=EndB.
'and Ref may be: 1=Easting or 2=Northing or 3=Difference
'Fiist a ForLoop to find Eastings of EndNodes (i=1)
'and then Northings (i=2)
Dim intCounter As Integer
For intCounter = 1 To 2
'DoLoop searchesing through rstNodes to find, first EndA's easting and northing
'and then those for EndB.
rstNode.MoveFirst
Do Until lngGrid(intCounter, 1) = rstNode!nodeID
lngGrid(intCounter, 2) = rstNode!easting
lngGrid(intCounter, 3) = rstNode!northing
If intCounter = 1 Then
Msg = "Easting of NodeA: " & Str(lngGrid(intCounter, 2)) & "Northing of nodeA: " & Str(lngGrid(intCounter, 3))
MsgBox Msg
Else
Msg = "Easting of NodeB: " & Str(lngGrid(intCounter, 2)) & "Northing of nodeB: " & Str(lngGrid(intCounter, 3))
MsgBox Msg
Exit Do 'Eastings and northings have been found for both end nodes
End If
rstNode.MoveNext
If rstNode.EOF Then rstNode.MoveFirst 'and continue searching nodes
Loop 'riffling through nodes
Next intCounter
End Sub
Sub Pythag()
'Now calculate the section length
'the diff in eastings
sglEastDiff = lngGrid(1, 2) - lngGrid(2, 2)
'and in northings
sglNorthDiff = lngGrid(1, 3) - lngGrid(2, 3)
'Now square the differences
sglEastDiff = sglEastDiff ^ 2
sglNorthDiff = sglNorthDiff ^ 2
sglSectionLength = sglEastDiff + sglNorthDiff
sglSectionLength = sglSectionLength ^ 0.5
Msg = "Section Length = " & Str(sglSectionLength)
rstSection!SectionLength = sglSectionLength
End Sub