VBA to Populate Excel Userform Treeview from MS SQL

[bhalbach]

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.

    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

 

[bhalbach]

The code doesn't set the tag for those bidItem nodes, so there isn't any text to retrieve. You'll have to copy the "Set n" style from the activity nodes to the bidItem nodes.

    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
            'Took this code out....
            'Me.TreeView1.Nodes.Add keyBidItem, tvwChild, keyActivity, nodeText
            'Replaced with this....
            Set n = Me.TreeView1.Nodes.Add(keyBidItem, tvwChild, keyActivity, nodeText) 'Replaced with this code
            n.Tag = rs.Fields.Item("BidItemID") & "," & rs.Fields.Item("ActivityID") & "," & rs.Fields.Item("BidItemNo") & "," & rs.Fields.Item("BidItemQuantity") & "," & rs.Fields.Item("BidItemUOM") & "," & rs.Fields.Item("TakeOffQuantity")
        End If

Yay…it works
Thank you so much for your help

 

[bhalbach]

I converted the data into an Access database and had to manipulate the connection code to accommodate that. However, in the pictures below, you can see that the first subnode's tag is set when the tree is populated and is later recalled in the tagArray variable. My code couldn't further process the "cmd.Parameters("@EstimateID").Value" and similar code, but the tagArray's values are correct. Therefore, I can't recreate your issue where tagArray(0) loses its value between that line and the assignment line at the beginning of the procedure.

This is my Access table from where the nodes are getting their values/tags. View attachment 57919

This shows that the first subnode tag is being set to these values
View attachment 57920

I added an extra MsgBox code to show the tag values when the nodes are selected
View attachment 57921

Here is the userform after clicking on the 1510 node
View attachment 57927

After clicking Add Activity Form, I randomly selected 27
View attachment 57923

Clicking OK sets the tagArray, the cursor shows the Tag value
View attachment 57924

All the values in tagArray
View attachment 57925

The value of tagArray(0) down in the code part I can't run (the parameters.value portion doesn't work well with the Access DB, I think. I wasn't going to play around to find out more. I just wanted to verify that the selectedNode tag comes through)
View attachment 57926

I am trying to expand on this now so when I click on a Node that more textboxes are populated from the recordset. Im having a difficult time understanding your code.

I tried expanding on the code in the following 2 Sub procedures but thas not working. I noted what I was trying to do in the code below.

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")
                    If Not IsNull(testVar) Then
                        rcrdSet.ActivityItemQuantity = rs.Fields.Item("ActivityItemQuantity")
                    End If
                    testVar = rs.Fields.Item("ActivityItemUOM")
                    If Not IsNull(testVar) Then
                        rcrdSet.ActivityItemUOM = rs.Fields.Item("ActivityItemUOM")
                    End If
 
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'I thought I could replicate this block of code with the new fields from the recordset
                    testVar = rs.Fields.Item("ActivityProductionCrew ")
                    If Not IsNull(testVar) Then
                        rcrdSet.ActivityProductionCrew = rs.Fields.Item("ActivityProductionCrew ")
                    End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                    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.Close

    Set Conn1 = Nothing
    Set rs = Nothing
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Then expand on this block of Code for the textboxes to be filled
        txtProductionCrew.Text = rSetTemp.ActivityProductionCrew
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    End If
End Sub

 

[shknbk2]

Go into the recordSetType class and add the ActivityProductionCrew parameter.

 

[bhalbach]

Go into the recordSetType class and add the ActivityProductionCrew parameter.

Ugh...I missed that.
Works, Thanks again