VBA to Populate Excel Userform Treeview from MS SQL

bhalbach

Board Regular
Joined
Mar 15, 2018
Messages
221
Office Version
  1. 2016
Platform
  1. Windows
I can not seem to figure this out, can someone assist please.

I have a userfrom in excel that has a treeview, I am trying to populate the treeview with a recordset from ms sql using ADO.

I have managed to populate the Parent Nodes but have not been able to figure out how to populate the child nodes. Everything with the connection to the database and getting a recordset returned seems to be working as I do get the parent nodes to populate.

I am a rookie in vba and have been able to eventually figure things out with google and youtube, but I am stuck on this one...cant find much online related to what I am trying to do.

I have tried the following code and I get a error " Error number = 2147257114 Invalid object"

This is the first time I have tried using treeview.

All assistance would be greatly appreciated.

VBA Code:
    Me.TreeView1.Nodes.Clear
    
    'load Treeview
    Do While Not rs.EOF
    
        Me.TreeView1.Nodes.Add = rs.Fields.Item("BidItemNo")
        Me.TreeView1.Nodes.Add rs.Fields.Item("BidItemNo"), tvwChild, rs.Fields.Item("BidItemDescription"), rs.Fields.Item("BidItemDescription")

        
    rs.MoveNext
    Loop
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
New UserForm2 code (don't remove the Const at the top of the code):
VBA Code:
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.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
Add a regular Module to the code and paste this:
VBA Code:
Public Type recordSetType
    ActivityCode As String
    ActivityItemDescription As String
    ActivityItemQuantity As String
    ActivityItemUOM As String
    BidItemCode As String
    BidItemDescription As String
    BidItemQuantity As String
    BidItemUOM As String
    TakeOffQuantity As String
End Type

Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
    Dim n As Node
    Dim Conn1 As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim sql As String
    
    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Conn1.ConnectionString = sConStr
    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 = txtEstimateNo

    Set rs = cmd.Execute
   
    'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
          
            If rSetTemp.ActivityCode <> "" Then
            
                If rs.Fields.Item("ActivityCode") = rcrdSet.ActivityCode And _
                  rs.Fields.Item("ActivityDescription") = rcrdSet.ActivityItemDescription Then
                    rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                    rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                    rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                    Exit Do
                End If
            
            Else
                rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                Exit Do
            End If
            
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close

    Set Conn1 = Nothing
    Set rs = Nothing
End Sub
I can't test it because I don't have the database, but try it out and see if it works.
 
Upvote 0
New UserForm2 code (don't remove the Const at the top of the code):
VBA Code:
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.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
Add a regular Module to the code and paste this:
VBA Code:
Public Type recordSetType
    ActivityCode As String
    ActivityItemDescription As String
    ActivityItemQuantity As String
    ActivityItemUOM As String
    BidItemCode As String
    BidItemDescription As String
    BidItemQuantity As String
    BidItemUOM As String
    TakeOffQuantity As String
End Type

Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
    Dim n As Node
    Dim Conn1 As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim sql As String
   
    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Conn1.ConnectionString = sConStr
    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 = txtEstimateNo

    Set rs = cmd.Execute
  
    'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
         
            If rSetTemp.ActivityCode <> "" Then
           
                If rs.Fields.Item("ActivityCode") = rcrdSet.ActivityCode And _
                  rs.Fields.Item("ActivityDescription") = rcrdSet.ActivityItemDescription Then
                    rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                    rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                    rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                    Exit Do
                End If
           
            Else
                rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                Exit Do
            End If
           
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close

    Set Conn1 = Nothing
    Set rs = Nothing
End Sub
I can't test it because I don't have the database, but try it out and see if it works.

Holy S***, I had no idea that this much code would be need. I would have never accomplished this on my own...I am very thankful for your time an knowledge

Getting an error at the following in the Module...Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
rSetTemp
Variable Not Defined

I marked the text as below in the code.

Also, the data base is brand new so I don't mind if you have it. Link to the Folder with the data base and the excel sheet.




VBA Code:
'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
          
            If [COLOR=rgb(41, 105, 176)]rSetTemp[/COLOR].ActivityCode <> "" Then
 
Upvote 0
Oops. Change rSetTemp to rcrdSet.
Looks like everything works perfectly...I'll validate all the values that are populating but it looks like it is correct. Nice work, and it seems fast.
So Awesome.

Couple things.
If Activity related fields are Null, which they will be...an Error occurs Runtime error '94': Invalid use of Null

-If it is the Root of the Treeview - The BidItem related fields and the Activity related fields should be cleared and blank.
-If it is a BidItem then Only the Bid Item related Controls be populate, right now if I go from a BidItem to a ActivityItem and then back to a BidItem the Activity related fields still have the data that was populated from the the Activity prior clicked on.
-If it is a ActivityItem then BidItem related and ActivityItem related both populated.
 
Upvote 0
A couple of procedure changes.
Userform:
VBA Code:
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
    
    rSetTemp.BidItemCode = ""
    rSetTemp.BidItemDescription = ""
    rSetTemp.ActivityCode = ""
    rSetTemp.ActivityItemDescription = ""
    rSetTemp.BidItemQuantity = ""
    rSetTemp.BidItemUOM = ""
    rSetTemp.ActivityItemQuantity = ""
    rSetTemp.ActivityItemUOM = ""
   
    Select Case NodeLevel(Node)
        Case 0
            bFillText = True
        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
Module:
VBA Code:
Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
    Dim n As Node
    Dim Conn1 As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim sql As String
    
    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Conn1.ConnectionString = sConStr
    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 = txtEstimateNo

    Set rs = cmd.Execute
   
    'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
          
            If rcrdSet.ActivityCode <> "" Then
            
                If rs.Fields.Item("ActivityCode") = rcrdSet.ActivityCode And _
                  rs.Fields.Item("ActivityDescription") = rcrdSet.ActivityItemDescription Then
                    rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    Exit Do
                End If
            
            Else
                rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                Exit Do
            End If
            
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close

    Set Conn1 = Nothing
    Set rs = Nothing
End Sub
See if this takes care of most issues. If the Null error still shows up, debug that line to see what comparison to make in the If statement that doesn't fail. For example, I don't know if this will work in some form:
VBA Code:
If Not rs.Fields.Item("ActivityCode") Is Null Then
 
Upvote 0
A couple of procedure changes.
Userform:
VBA Code:
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
   
    rSetTemp.BidItemCode = ""
    rSetTemp.BidItemDescription = ""
    rSetTemp.ActivityCode = ""
    rSetTemp.ActivityItemDescription = ""
    rSetTemp.BidItemQuantity = ""
    rSetTemp.BidItemUOM = ""
    rSetTemp.ActivityItemQuantity = ""
    rSetTemp.ActivityItemUOM = ""
  
    Select Case NodeLevel(Node)
        Case 0
            bFillText = True
        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
Module:
VBA Code:
Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
    Dim n As Node
    Dim Conn1 As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim sql As String
   
    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Conn1.ConnectionString = sConStr
    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 = txtEstimateNo

    Set rs = cmd.Execute
  
    'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
         
            If rcrdSet.ActivityCode <> "" Then
           
                If rs.Fields.Item("ActivityCode") = rcrdSet.ActivityCode And _
                  rs.Fields.Item("ActivityDescription") = rcrdSet.ActivityItemDescription Then
                    rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    Exit Do
                End If
           
            Else
                rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                Exit Do
            End If
           
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close

    Set Conn1 = Nothing
    Set rs = Nothing
End Sub
See if this takes care of most issues. If the Null error still shows up, debug that line to see what comparison to make in the If statement that doesn't fail. For example, I don't know if this will work in some form:
VBA Code:
If Not rs.Fields.Item("ActivityCode") Is Null Then
When I go from a BidItem to a ActivityItem the BidQuantity, BidUOM and TakeOffQuantity(I missed telling you the TakeOffQuanty, I fixed it... it is Label164)
-The Bid Quantity, BidUOM and TakeOffQuantity should populate with its BidItem parent values when on an ActivityItem

Looks like the Null works sometimes....I trying to find the pattern that causes the error. It seems to be erroring at ActivityItemUOM
-ActivityCode,ActivityDescription,ActivityItemQuantity and ActivityItemUOM can potentially be Null
 
Upvote 0
A couple of procedure changes.
Userform:
VBA Code:
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
   
    rSetTemp.BidItemCode = ""
    rSetTemp.BidItemDescription = ""
    rSetTemp.ActivityCode = ""
    rSetTemp.ActivityItemDescription = ""
    rSetTemp.BidItemQuantity = ""
    rSetTemp.BidItemUOM = ""
    rSetTemp.ActivityItemQuantity = ""
    rSetTemp.ActivityItemUOM = ""
  
    Select Case NodeLevel(Node)
        Case 0
            bFillText = True
        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
Module:
VBA Code:
Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
    Dim n As Node
    Dim Conn1 As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim sql As String
   
    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Conn1.ConnectionString = sConStr
    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 = txtEstimateNo

    Set rs = cmd.Execute
  
    'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
         
            If rcrdSet.ActivityCode <> "" Then
           
                If rs.Fields.Item("ActivityCode") = rcrdSet.ActivityCode And _
                  rs.Fields.Item("ActivityDescription") = rcrdSet.ActivityItemDescription Then
                    rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    Exit Do
                End If
           
            Else
                rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                Exit Do
            End If
           
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close

    Set Conn1 = Nothing
    Set rs = Nothing
End Sub
See if this takes care of most issues. If the Null error still shows up, debug that line to see what comparison to make in the If statement that doesn't fail. For example, I don't know if this will work in some form:
VBA Code:
If Not rs.Fields.Item("ActivityCode") Is Null Then
It is erroring at

If Not rs.Fields.Item("ActivityCode") Is Null Then
 
Upvote 0
I don't know where in the code you put that If statement.

Try this, which adds the three items back when Activity node is selected. I also made a new testing variable testVar that I think shouldn't have any issues with Null values. When the code runs and errors at setting an Activity value to Null, put the cursor over the testVar in the line just before the error and find out what its value is.
VBA Code:
Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
    Dim n As Node
    Dim Conn1 As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim testVar as Variant

    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Conn1.ConnectionString = sConStr
    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 = txtEstimateNo

    Set rs = cmd.Execute
   
    'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
          
            If rcrdSet.ActivityCode <> "" Then
            
                If rs.Fields.Item("ActivityCode") = rcrdSet.ActivityCode And _
                  rs.Fields.Item("ActivityDescription") = rcrdSet.ActivityItemDescription Then
                    testVar = rs.Fields.Item("ActivityItemQuantity")
                    rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    testVar = rs.Fields.Item("ActivityItemUOM")
                    rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                    rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                    rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                    Exit Do
                End If
            
            Else
                rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                Exit Do
            End If
            
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close

    Set Conn1 = Nothing
    Set rs = Nothing
End Sub
 
Upvote 0
I don't know where in the code you put that If statement.

Try this, which adds the three items back when Activity node is selected. I also made a new testing variable testVar that I think shouldn't have any issues with Null values. When the code runs and errors at setting an Activity value to Null, put the cursor over the testVar in the line just before the error and find out what its value is.
VBA Code:
Sub FillRecordSet(ByRef rcrdSet As recordSetType, sConStr As String, txtEstimateNo As String)
    Dim n As Node
    Dim Conn1 As ADODB.Connection
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim testVar as Variant

    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    Set rs = New ADODB.Recordset

    Conn1.ConnectionString = sConStr
    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 = txtEstimateNo

    Set rs = cmd.Execute
  
    'load Treeview
    Do While Not rs.EOF
        If rs.Fields.Item("BidItemNo") = rcrdSet.BidItemCode And _
          rs.Fields.Item("BidItemDescription") = rcrdSet.BidItemDescription Then
         
            If rcrdSet.ActivityCode <> "" Then
           
                If rs.Fields.Item("ActivityCode") = rcrdSet.ActivityCode And _
                  rs.Fields.Item("ActivityDescription") = rcrdSet.ActivityItemDescription Then
                    testVar = rs.Fields.Item("ActivityItemQuantity")
                    rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    testVar = rs.Fields.Item("ActivityItemUOM")
                    rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                    rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                    rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                    Exit Do
                End If
           
            Else
                rcrdSet.BidItemQuantity = rs.Fields.Item("BidItemQuantity")
                rcrdSet.BidItemUOM = rs.Fields.Item("BidItemUOM")
                rcrdSet.TakeOffQuantity = rs.Fields.Item("TakeOffQuantity")
                Exit Do
            End If
           
        End If
        rs.MoveNext
    Loop
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close

    Set Conn1 = Nothing
    Set rs = Nothing
End Sub

Still error

testVar=Null
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top