Here is some of the code for updating the app. Iit is waht happens every time it refreshes.
Sub UpdateOutages()
Dim rsTemp As DAO.Recordset
Dim rsSSTemp As DAO.Recordset
Dim strSQL As String
Dim MyOutage As clsOutageLocation
Dim strDev As String
Dim ndLocation As MSComctlLib.Node
Dim ndDevice As MSComctlLib.Node
Dim ndBucket As MSComctlLib.Node
Dim intcnt As Integer
On Error GoTo Err_Control
'STATUS Field Values and Description
'1 Active Record(Power Is Off)
'2 Power Restored
'3 Call Back
'4 No Response
'5 Still Out of Power
'6 Undialable
'7 Error
'8 Max Dial
strSQL = "Select * from VIEW_RECORDS WHERE [STATUS] = 1 OR [STATUS] = 5 Order by [SUBSTATION],[CIRCUIT],[MAPNUM]"
Set rsTemp = OpenRSPorche(strSQL)
'Add Outages to the collection
Do Until rsTemp.EOF
Set MyOutage = New clsOutageLocation
If IsNull(rsTemp.Fields("MAPNUM")) = False Then
MyOutage.Location = rsTemp.Fields("MAPNUM")
If Len(rsTemp.Fields("DEVICE")) > 10 Then
strDev = Left(rsTemp.Fields("DEVICE"), 3) & "-" & Mid(rsTemp.Fields("DEVICE"), 4, 2) & "-" & Mid(rsTemp.Fields("DEVICE"), 6, Len(rsTemp.Fields("DEVICE")) - 5)
Else
strDev = IIf(rsTemp.Fields("DEVICE") = " ", "Unknown", rsTemp.Fields("DEVICE"))
End If
MyOutage.Device = strDev
MyOutage.SubCir = IIf(Len(rsTemp.Fields("SUBSTATION")) = 2, rsTemp.Fields("SUBSTATION") & "-0" & rsTemp.Fields("CIRCUIT"), "0" & rsTemp.Fields("SUBSTATION") & "-0" & rsTemp.Fields("CIRCUIT"))
If IsNull(rsTemp.Fields("BUCKET_NAME")) = False Then
MyOutage.Bucket = rsTemp.Fields("BUCKET_NAME")
Else
MyOutage.Bucket = ""
End If
AddOutageToCollection MyOutage, colOutages
End If
rsTemp.MoveNext
Loop
'check to see if any need to be deleted
If colOutages Is Nothing Then
ResetBlockScale
Timer2.Enabled = False
Else
Timer2.Enabled = True
For Each MyOutage In colOutages
rsTemp.FindFirst "MAPNUM = '" & MyOutage.Location & "'"
If rsTemp.NoMatch = True Then
RemoveOutage MyOutage
colOutages.Remove MyOutage.Location
End If
Next
End If
If cmdView.Caption = "Click to View Buckets" Then
TreeView1(0).Visible = True
If TreeView1(1).Nodes.Count > 0 Then
cmdView.Enabled = True
ClearBuckets
InsertBuckets
HideBuckets
Else
cmdView.Enabled = False
End If
Else
If TreeView1(1).Nodes.Count > 0 Then
cmdView.Enabled = True
TreeView1(1).Visible = True
ClearBuckets
InsertBuckets
ShowBuckets
Else
cmdView.Enabled = False
cmdView.Caption = "Click to View Buckets"
TreeView1(0).Visible = True
End If
End If
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case Else
LogError Err.Number, Err.Description, "UpdateOutages", "OutageTree.ctl"
Resume Next
End Select
End Sub
Private Function AddOutageToCollection(Outage As clsOutageLocation, col As Collection) As Boolean
Dim bKeyExists As Boolean
Dim tempOutage As clsOutageLocation
On Error GoTo addOutageToCollection_Error
bKeyExists = False
col.Add Outage, Outage.Location '<=set the key so it is easy to find the outage
If bKeyExists = False Then
'Add to Treeview and Blocks
If Outage.Bucket <> "" Then
'Propably need to Add the Blocks in the AddNodeToTree Sub
AddNodeToTree 1, Outage.Bucket, Outage.Device, Outage.Location, Outage
Else
'Propably need to Add the Blocks in the AddNodeToTree Sub
AddNodeToTree 0, Outage.SubCir, Outage.Device, Outage.Location, Outage
End If
Else
Set tempOutage = col.Item(Outage.Location)
If tempOutage.Bucket <> Outage.Bucket Then
'delete the old outage in the tree add it to the correct tree and bucket
RemoveOutage tempOutage
tempOutage.Bucket = Outage.Bucket
tempOutage.Device = Outage.Device
tempOutage.SubCir = Outage.SubCir
If tempOutage.Bucket <> "" Then
AddNodeToTree 1, tempOutage.Bucket, tempOutage.Device, tempOutage.Location, Outage
Else
AddNodeToTree 0, tempOutage.SubCir, tempOutage.Device, tempOutage.Location, Outage
End If
End If
End If
ExitHere:
bKeyExists = False
On Error GoTo 0
Exit Function
addOutageToCollection_Error:
Select Case Err.Number
Case 457 'the key already exists
bKeyExists = True
Resume Next
Case Else
LogError Err.Number, Err.Description, "AddOutageToCollection", "OutageTree.ctl"
Resume ExitHere
End Select
End Function
Private Sub AddNodeToTree(intTreeIndex As Integer, strSC As String, strDev As String, strLoc As String, Outage As clsOutageLocation)
Dim strBucketKey As String
Dim strDeviceKey As String
Dim strLocKey As String
Dim bKeyExist As Boolean
Dim varInsPnt As Variant
Dim strLocList As String
Dim strAttValue As String
Dim strType As String
Dim rsSSTemp As DAO.Recordset
Dim strHandle As String
Dim blnTreeVisible As Boolean
On Error GoTo Err_Control
strBucketKey = strSC
strDeviceKey = strSC & strDev
strLocKey = Outage.Location
'Add Sub-Cir
TreeView1(intTreeIndex).Nodes.Add Key:=strBucketKey, Text:=strSC
Set nd = TreeView1(intTreeIndex).Nodes(strBucketKey)
nd.Tag = "SCS"
If bKeyExist = False Then
'Add The Block if it is a bucket
If Outage.Bucket <> "" Then
' If GetCenter(Outage.Bucket, varInsPnt) = True Then
' AddBlocks varInsPnt, "OutageCalls", "Flag", Outage.Bucket, Outage.Bucket
' End If
Else
nd.Expanded = True
End If
End If
bKeyExist = False
'Add Device
TreeView1(intTreeIndex).Nodes.Add strSC, tvwChild, strDeviceKey, strDev
Set nd = TreeView1(intTreeIndex).Nodes(strDeviceKey)
nd.Tag = "DEV"
If bKeyExist = False Then
If Outage.Bucket = "" Then
nd.Expanded = True
End If
'Add The Block
strLocList = "Select * from SSMap WHERE [Location] LIKE '*" & strDev & "*'"
strAttValue = strDev
If InStr(2, strDev, "RC") > 2 Then
strType = "RC"
ElseIf InStr(2, strDev, "FU") > 2 Then
strType = "FU"
Else
strType = ""
End If
If strType <> "" Then
Set rsSSTemp = OpenRSSSMap(strLocList)
If rsSSTemp.BOF = False Or rsSSTemp.EOF = False Then
rsSSTemp.MoveFirst
strHandle = rsSSTemp.Fields("Handle")
AddBlocks HandleToInsertionPoint(strHandle), "OutageCalls", strType, strAttValue, strSC
End If
End If
End If
bKeyExist = False
'Add Location
TreeView1(intTreeIndex).Nodes.Add strSC & strDev, tvwChild, strLocKey, strLoc
Set nd = TreeView1(intTreeIndex).Nodes(strLocKey)
nd.Tag = "LOC"
If bKeyExist = False Then
If Outage.Bucket = "" Then
nd.Expanded = True
End If
'Add The Block
strLocList = "Select * from SSMap WHERE [Location] LIKE '*" & strLoc & "*'"
strAttValue = strLoc
strType = "SER"
Set rsSSTemp = OpenRSSSMap(strLocList)
If rsSSTemp.BOF = False Or rsSSTemp.EOF = False Then
rsSSTemp.MoveFirst
strHandle = rsSSTemp.Fields("Handle")
AddBlocks HandleToInsertionPoint(strHandle), "OutageCalls", strType, strAttValue, strSC
End If
End If
bKeyExist = False
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case 35602
'Duplicate key is not unique
bKeyExist = True
Err.Clear
Resume Next
Case Else
LogError Err.Number, Err.Description, "AddNodeToTree", "OutageTree.ctl"
Resume Exit_Here
End Select
End Sub
Sub RemoveOutage(Outage As clsOutageLocation)
Dim strDev As String
Dim ndLocation As MSComctlLib.Node
Dim ndDevice As MSComctlLib.Node
Dim ndBucket As MSComctlLib.Node
On Error GoTo Err_Control
'Remove From Treeview Here and Blocks
If Outage.Bucket <> "" Then
Set ndLocation = TreeView1(1).Nodes(Outage.Location)
Set ndDevice = ndLocation.Parent
If ndDevice.Children = 1 Then
Set ndBucket = ndDevice.Parent
If ndBucket.Children = 1 Then
'Remove Bucket,Device, & Location
RemoveBucket Outage.Bucket
RemoveDevice Outage.Device
RemoveLocation Outage.Location
TreeDeleteSection 1, ndBucket
Else
'Remove Device & Location
RemoveDevice Outage.Device
RemoveLocation Outage.Location
TreeDeleteSection 1, ndDevice
End If
Else
'Remove Location
RemoveLocation Outage.Location
TreeDeleteSection 1, ndLocation
End If
Else
Set ndLocation = TreeView1(0).Nodes(Outage.Location)
Set ndDevice = ndLocation.Parent
If ndDevice.Children = 1 Then
Set ndBucket = ndDevice.Parent
If ndBucket.Children = 1 Then
'Remove Bucket,Device, & Location
RemoveDevice Outage.Device
RemoveLocation Outage.Location
TreeDeleteSection 0, ndBucket
Else
'Remove Device & Location
RemoveDevice Outage.Device
RemoveLocation Outage.Location
TreeDeleteSection 0, ndDevice
End If
Else
'Remove Location
RemoveLocation Outage.Location
TreeDeleteSection 0, ndLocation
End If
End If
Exit_Here:
Exit Sub
Err_Control:
Select Case Err.Number
Case Else
LogError Err.Number, Err.Description, "RemoveOutage", "OutageTree.ctl"
Resume Next
End Select
End Sub