Create Sub-Routine for the following program.

[Amazing1984]

Ok I am trying to create a subrouting for the the node that is highlited in RED Color. I would like to delete that from this program but put it in seprate function and call it whenever i need to.

Please Help

Thank you


Public Function GetSub(strSubId As String)
Dim strSQL As String
Dim rsDeviceNumber As DAO.Recordset
Dim rsCymSubrel As DAO.Recordset
Dim Value As Integer, Valuey As Integer
'Dim rsX As DAO.Recordset
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM TblComponents WHERE ComponentId Like '" & strSubId & "*'"
DoCmd.RunSQL "DELETE * FROM TblNodes"
DoCmd.SetWarnings True

strSQL = "SELECT CYMTRANSFORMER.DeviceNumber, CYMTRANSFORMER.NetworkId, CYMTRANSFORMER.EquipmentId, CYMEQTRANSFORMER.NominalRatingKVA, CYMEQTRANSFORMER.PrimaryVoltageKVLL, CYMEQTRANSFORMER.SecondaryVoltageKVLL, CYMSECTIONDEVICE.DeviceType, CYMSECTIONDEVICE.Location, CYMSECTION.SectionId, CYMSECTION.FromNodeId, CYMNODE.X, CYMNODE.Y, CYMSECTION.ToNodeId, CYMNODE_1.X, CYMNODE_1.Y"
strSQL = strSQL & " FROM ((((CYMTRANSFORMER INNER JOIN CYMSECTIONDEVICE ON CYMTRANSFORMER.DeviceNumber = CYMSECTIONDEVICE.DeviceNumber)" _
& " INNER JOIN CYMSECTION ON CYMSECTIONDEVICE.SectionId = CYMSECTION.SectionId)" _
& " INNER JOIN CYMNODE ON CYMSECTION.FromNodeId = CYMNODE.NodeId) INNER JOIN CYMNODE AS CYMNODE_1 ON CYMSECTION.ToNodeId = CYMNODE_1.NodeId)" _
& " INNER JOIN CYMEQTRANSFORMER ON CYMTRANSFORMER.EquipmentId = CYMEQTRANSFORMER.EquipmentId"
strSQL = strSQL & " WHERE (((CYMTRANSFORMER.NetworkId) Like '" & strSubId & "*'));"
Set rsDeviceNumber = mdbCymdistSubrel.OpenRecordset(strSQL)
Set rsCymSubrel = mdbCymdistSubrel.OpenRecordset("TblComponents")
'Set rsX = rsDeviceNumber

rsDeviceNumber.MoveFirst
Do Until rsDeviceNumber.EOF
Debug.Print rsDeviceNumber!DeviceNumber, rsDeviceNumber!FromNodeId, rsDeviceNumber![CYMNODE.X], rsDeviceNumber![CYMNODE.Y], rsDeviceNumber!ToNodeId, rsDeviceNumber![CYMNODE_1.X], rsDeviceNumber![CYMNODE_1.Y]
' Value = FromNode()
' Valuey = ToNode()
Dim rsTblNodes As DAO.Recordset
Dim lngFromNodeId As Long, lngToNodeId As Long
Set rsTblNodes = mdbCymdistSubrel.OpenRecordset("TblNodes")
rsTblNodes.FindFirst "NodeName = '" & rsDeviceNumber!FromNodeId & "'"
If rsTblNodes.NoMatch Then
rsTblNodes.AddNew
rsTblNodes!NodeName = rsDeviceNumber!FromNodeId
rsTblNodes!X = rsDeviceNumber![CYMNODE.X]
rsTblNodes!Y = rsDeviceNumber![CYMNODE.Y]
lngFromNodeId = rsTblNodes!nodeid
rsTblNodes.Update
Else
lngFromNodeId = rsTblNodes!nodeid
End If
rsTblNodes.FindFirst "NodeName = '" & rsDeviceNumber!ToNodeId & "'"
If rsTblNodes.NoMatch Then
rsTblNodes.AddNew
rsTblNodes!NodeName = rsDeviceNumber!ToNodeId
rsTblNodes!X = rsDeviceNumber![CYMNODE_1.X]
rsTblNodes!Y = rsDeviceNumber![CYMNODE_1.Y]
lngToNodeId = rsTblNodes!nodeid
rsTblNodes.Update
Else
lngToNodeId = rsTblNodes!nodeid
End If
rsCymSubrel.AddNew
rsCymSubrel!ComponentId = Trim(rsDeviceNumber!DeviceNumber)
rsCymSubrel!ComponentTypeId = 2
rsCymSubrel!FromNode = lngFromNodeId
rsCymSubrel!ToNode = lngToNodeId
rsCymSubrel.Update


rsDeviceNumber.MoveNext
Loop
End Function

 

[Joe4]

Duplicate: http://www.mrexcel.com/forum/showthread.php?t=489198

Please do not post the same question multiple times. All clarifications, follow-ups, and bumps should be posted back to the original thread. Per forum rules, posts of a duplicate nature will be locked or deleted:
http://www.mrexcel.com/forum/showthread.php?t=127080