Sub ProcName()
Dim n As Node
Dim Conn1 As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim sql As String
Dim keyBidItem As String
Dim keyActivity As String
Dim keyResource As String
Dim keyNewlevel As String
Dim nodeText As String
With Me.TreeView1
.Appearance = ccFlat
.CheckBoxes = False
.LineStyle = tvwRootLines
.Nodes.Clear
End With
Set Conn1 = New ADODB.Connection
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
Conn1.ConnectionString = SQLConStr
Conn1.Open
cmd.ActiveConnection = Conn1
'On Error GoTo ErrorHandler
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "spGetTeeviewData"
cmd.Parameters.Refresh
cmd.NamedParameters = True
cmd.Parameters("@EstimateID").Value = Me.txtEstimateNo.Value
Set rs = cmd.Execute
Me.Tag = rs.Fields.Item("BidItemID") & "," & rs.Fields.Item("ActivityItemID")
Me.TreeView1.Nodes.Clear
Me.TreeView1.Nodes.Add , , "root1", Me.txtContractTitle.Value
'load Treeview
Do While Not rs.EOF
keyBidItem = "BIN" & rs.Fields.Item("BidItemNo")
nodeText = rs.Fields.Item("BidItemNo") & " - " & rs.Fields.Item("BidItemDescription")
If Not NodeExists(keyBidItem) Then
Me.TreeView1.Nodes.Add "root1", tvwChild, keyBidItem, nodeText
End If
keyActivity = keyBidItem & "AC" & rs.Fields.Item("ActivityCode")
nodeText = rs.Fields.Item("ActivityCode") & " : " & rs.Fields.Item("ActivityDescription")
'Check for null
If nodeText <> " : " Then
Me.TreeView1.Nodes.Add keyBidItem, tvwChild, keyActivity, nodeText
End If
' keyResource = keyActivity & "RC" & rs.Fields.Item("ResourceCode")
' nodeText = rs.Fields.Item("ResourceCode") & " : " & rs.Fields.Item("ResourceDescription")
' If nodeText <> " : " Then
' Me.TreeView1.Nodes.Add keyActivity, tvwChild, keyResource, nodeText
' End If
'
' keyNewlevel = keyResource & "NLC" & rs.Fields.Item("NewLevelCode")
' nodeText = rs.Fields.Item("NewLevelCode") & " : " & rs.Fields.Item("NewLevelDescription")
' If nodeText <> " : " Then
' Me.TreeView1.Nodes.Add keyResource, tvwChild, keyNewlevel, nodeText
' End If
rs.MoveNext
Loop
'Optional if you want to have all nodes expanded when the form displays
For Each n In Me.TreeView1.Nodes
n.Expanded = True
Next n
On Error GoTo 0
Conn1.Close
Set Conn1 = Nothing
Set rs = Nothing
Exit Sub
ErrorHandler:
End Sub
Function NodeExists(nText As String) As Boolean
Dim n As Node
For Each n In Me.TreeView1.Nodes
If InStr(1, n.Key, nText) > 0 Then
NodeExists = True
Exit Function
End If
Next
NodeExists = False
End Function
Private Sub CommandButton1_Click()
Call ProcName
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
Dim sCode As String
Dim sDesc As String
Dim a As Variant
Dim rSetTemp As recordSetType
Dim bFillText As Boolean
Select Case NodeLevel(Node)
Case 1 'Node is at BidItem level, so populate BitItem objects
a = Split(Node.Text, " - ") 'Creates array based on " : " as the separation string. Since the node text should only have one of them, a 2 item array should be formed
rSetTemp.BidItemCode = a(0)
rSetTemp.BidItemDescription = a(1)
rSetTemp.ActivityCode = ""
rSetTemp.ActivityItemDescription = ""
FillRecordSet rSetTemp, SQLConStr, Me.txtEstimateNo.Text
bFillText = True
Case 2 'Node is at Activity level, so populate Activity objects
a = Split(Node.Text, " : ") 'Creates array based on " : " as the separation string. Since the node text should only have one of them, a 2 item array should be formed
rSetTemp.ActivityCode = a(0)
rSetTemp.ActivityItemDescription = a(1)
a = Split(Node.Parent.Text, " - ")
rSetTemp.BidItemCode = a(0)
rSetTemp.BidItemDescription = a(1)
FillRecordSet rSetTemp, SQLConStr, Me.txtEstimateNo.Text
bFillText = True
End Select
If bFillText Then
TextBox35.Text = rSetTemp.BidItemCode
Label163.Caption = rSetTemp.BidItemDescription
TextBox49.Text = rSetTemp.ActivityCode
TextBox48.Text = rSetTemp.ActivityItemDescription
Label168.Caption = rSetTemp.BidItemQuantity
Label165.Caption = rSetTemp.BidItemUOM
TextBox47.Text = rSetTemp.ActivityItemQuantity
TextBox46.Text = rSetTemp.ActivityItemUOM
End If
End Sub
Private Function NodeLevel(Node As MSComctlLib.Node) As Integer
Dim withoutSlashes As Integer
Dim withSlashes As Integer
withSlashes = Len(Node.FullPath)
withoutSlashes = Len(Replace(Node.FullPath, "\", ""))
NodeLevel = withSlashes - withoutSlashes
End Function
