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]

Do all of these fill in the record as expected?

        cmd.Parameters("@EstimateID").Value = frmEstimate_Main.txtEstimateNo.Value
        cmd.Parameters("@BidItemID").Value = frmEstimate_Main.txtEstimateNo.Value
        cmd.Parameters("@BidItemNo").Value = Me.listviewLibraryActivityList.ListItems(X)
        cmd.Parameters("@ActivityID").Value = Me.listviewLibraryActivityList.ListItems(X)
        cmd.Parameters("@ActivityCode").Value = Me.listviewLibraryActivityList.ListItems(X)
        cmd.Parameters("@ActivityItemQuantity").Value = Me.listviewLibraryActivityList.ListItems(X)
        cmd.Parameters("@ActivityItemUOM").Value = Me.listviewLibraryActivityList.ListItems(X)

One thing I see with the tag lines is that you have two '='. Does it work with just this?

cmd.Parameters("@BidItemID").Value = tagArray(0)

You can also put a breakpoint (F9) on this line, and when the code pauses, put the cursor over tagArray(0), and it will show you its value. Is it what you expected?

The code I sent you only works if the listview is on the same Form as the treeview. If the listview is on a separate form I get error number = 2147221513 Scubscript out of range

 

[shknbk2]

The code I sent you only works if the listview is on the same Form as the treeview.

"Me" refers to the form that is the owner of the code module you have the "Me" in. If the form doesn't have a ListView, there is no Me.ListView for that form.

For all three values, you only refer to the item in the ListView at location X, but you don't refer to the subItems across the columns. I think that the first column always returns the value unless you specify the subItem. Try something like this:

cmd.Parameters("@ActivityID").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(1)
cmd.Parameters("@ActivityCode").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(2)
cmd.Parameters("@ActivityItemUOM").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(3)

 

[bhalbach]

"Me" refers to the form that is the owner of the code module you have the "Me" in. If the form doesn't have a ListView, there is no Me.ListView for that form.

For all three values, you only refer to the item in the ListView at location X, but you don't refer to the subItems across the columns. I think that the first column always returns the value unless you specify the subItem. Try something like this:

cmd.Parameters("@ActivityID").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(1)
cmd.Parameters("@ActivityCode").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(2)
cmd.Parameters("@ActivityItemUOM").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(3)

I should have known the about the .subitems(1) code...was drawing a blank.

I can get values from the tagArray and listview into the correct fields of the data base table...but they are not the correct values for the selected node of the treeview.
Regardless of which node I select on the Treeview, when I check an item in the Listview the values that are inserted to the data base table are related to the 1st Parent Node BidItem. The node I select is highlighted blue, when I check an item on the Listview the highlight goes away...it is like it has disregards that I had selected it.

With the inserted values, every item row in the Listview is inserted. It should only be the checked item.
With the Item rows of the Listview, the first item in the Listview throws an error if checked...asking for the @EstimateID parameter that should getting supplied byfrmEstimate_Main.txtEstimateNo.Text.
With the item rows of the Listview, the last item in the listview does not insert to the data base table.

For X = 1 To Me.listviewLibraryActivityList.ListItems.Count
    If Me.listviewLibraryActivityList.ListItems(X).Checked = True Then
        Me.listviewLibraryActivityList.ListItems(X).Selected = True
    Else
        Me.listviewLibraryActivityList.ListItems(X).Selected = False

        cmd.Parameters("@EstimateID").Value = frmEstimate_Main.txtEstimateNo.Text 'works
        cmd.Parameters("@BidItemID").Value = tagArray(0)
        cmd.Parameters("@BidItemNo").Value = tagArray(2)
        cmd.Parameters("@ActivityID").Value = Me.listviewLibraryActivityList.ListItems(X)
        cmd.Parameters("@ActivityCode").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(1)
        cmd.Parameters("@ActivityItemUOM").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(3)
        
    End If
    
    Me.listviewLibraryActivityList.ListItems(X).Checked = False
    Set rs = cmd.Execute
    
    Next X

 

[shknbk2]

I can get values from the tagArray and listview into the correct fields of the data base table...but they are not the correct values for the selected node of the treeview.

The selected node has nothing to do with tagArray. Before the nodes are added, the UserForm Tag is set to the comma-separated string. tagArray gets filled from the tag of the UserForm not any selected node. It will always return the same UserForm.Tag result with the current code. If you want to add tags to the specific nodes and return those values, you'll have to change the code.

The node I select is highlighted blue, when I check an item on the Listview the highlight goes away

The highlighting doesn't stay visible when another object is selected. That's how it works. It doesn't mean that the node has become deselected. . . it is just not displayed when the node tree loses focus.

With the inserted values, every item row in the Listview is inserted. It should only be the checked item.

Your code pseudo code:
For every row in the ListView, see if the row is checked.
If it is checked, select the row.
If the row is not checked, deselect the row and set the various cmd.Parameters.
Then uncheck the row and set rs = cmd.Execute.

You would have to run this twice to get the checked rows to set the cmd.Parameters: first time would uncheck the row but select it, the second time would deselect and set the cmd.Parameters.

Is this how you want it to work?

Getting it to run only on the checked rows would be something like this:

For X = 1 To Me.listviewLibraryActivityList.ListItems.Count
    If Me.listviewLibraryActivityList.ListItems(X).Checked = True Then
        Me.listviewLibraryActivityList.ListItems(X).Checked  = False
        cmd.Parameters("@EstimateID").Value = frmEstimate_Main.txtEstimateNo.Text 'works
        cmd.Parameters("@BidItemID").Value = tagArray(0)
        cmd.Parameters("@BidItemNo").Value = tagArray(2)
        cmd.Parameters("@ActivityID").Value = Me.listviewLibraryActivityList.ListItems(X)
        cmd.Parameters("@ActivityCode").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(1)
        cmd.Parameters("@ActivityItemUOM").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(3)
        Set rs = cmd.Execute
    End If
Next X

 

[bhalbach]

The selected node has nothing to do with tagArray. Before the nodes are added, the UserForm Tag is set to the comma-separated string. tagArray gets filled from the tag of the UserForm not any selected node. It will always return the same UserForm.Tag result with the current code. If you want to add tags to the specific nodes and return those values, you'll have to change the code.


The highlighting doesn't stay visible when another object is selected. That's how it works. It doesn't mean that the node has become deselected. . . it is just not displayed when the node tree loses focus.



Your code pseudo code:
For every row in the ListView, see if the row is checked.
If it is checked, select the row.
If the row is not checked, deselect the row and set the various cmd.Parameters.
Then uncheck the row and set rs = cmd.Execute.

You would have to run this twice to get the checked rows to set the cmd.Parameters: first time would uncheck the row but select it, the second time would deselect and set the cmd.Parameters.

Is this how you want it to work?

Getting it to run only on the checked rows would be something like this:

For X = 1 To Me.listviewLibraryActivityList.ListItems.Count
    If Me.listviewLibraryActivityList.ListItems(X).Checked = True Then
        Me.listviewLibraryActivityList.ListItems(X).Checked  = False
        cmd.Parameters("@EstimateID").Value = frmEstimate_Main.txtEstimateNo.Text 'works
        cmd.Parameters("@BidItemID").Value = tagArray(0)
        cmd.Parameters("@BidItemNo").Value = tagArray(2)
        cmd.Parameters("@ActivityID").Value = Me.listviewLibraryActivityList.ListItems(X)
        cmd.Parameters("@ActivityCode").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(1)
        cmd.Parameters("@ActivityItemUOM").Value = Me.listviewLibraryActivityList.ListItems(X).SubItems(3)
        Set rs = cmd.Execute
    End If
Next X

I completely misunderstood the tagArray. I thought each node had the values for their respective line from the recordset…I was hoping to extract from each specific node that I selected. Didn’t realize it was on the form.tag.

 

[shknbk2]

Find and remove the Me.Tag lines (I don't know where they are anymore . . . too much code).

Wherever you have

Me.TreeView1.Nodes.Add keyBidItem, tvwChild, keyActivity, nodeText

change it to

set n = Me.TreeView1.Nodes.Add(keyBidItem, tvwChild, keyActivity, nodeText)
n.Tag = . . .

set n.Tag to whatever comma-separated string you are looking for.

 

[bhalbach]

Find and remove the Me.Tag lines (I don't know where they are anymore . . . too much code).

Wherever you have

Me.TreeView1.Nodes.Add keyBidItem, tvwChild, keyActivity, nodeText

change it to

set n = Me.TreeView1.Nodes.Add(keyBidItem, tvwChild, keyActivity, nodeText)
n.Tag = . . .

set n.Tag to whatever comma-separated string you are looking for.

I have made the changes as follows, but can't figure out how to get the value from the tag.

'Took this code out....
'Me.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") 
    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
            '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

'Trying to get the values from the tag with this...i have tried numerous different things with no success.

Private Sub cmdAddSelectedActivities_Click()

Dim x As Integer
Dim Conn1 As ADODB.Connection
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim sql As String
Dim tagArray As Variant
    tagArray = Split(Me.TreeView1.Nodes.Item.Tag, ",")

    Set Conn1 = New ADODB.Connection
    Set cmd = New ADODB.Command
    
    Conn1.ConnectionString = SQLConStr
    Conn1.Open
    
    cmd.ActiveConnection = Conn1

    Conn1.BeginTrans

    On Error GoTo ErrorHandler
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "spInsertEstimateActivityItem"
    cmd.Parameters.Refresh
    cmd.NamedParameters = True

    For x = 1 To Me.listviewLibraryActivityList.ListItems.Count
        If Me.listviewLibraryActivityList.ListItems(x).Checked = True Then
            Me.listviewLibraryActivityList.ListItems(x).Checked = False
            cmd.Parameters("@EstimateID").Value = frmEstimate_Main.txtEstimateNo.Text 'works
            cmd.Parameters("@BidItemID").Value = tagArray(0)
            cmd.Parameters("@BidItemNo").Value = tagArray(2)
            cmd.Parameters("@ActivityID").Value = Me.listviewLibraryActivityList.ListItems(x)
            cmd.Parameters("@ActivityCode").Value = Me.listviewLibraryActivityList.ListItems(x).SubItems(1)
            cmd.Parameters("@ActivityItemUOM").Value = Me.listviewLibraryActivityList.ListItems(x).SubItems(3)
            Set rs = cmd.Execute
        End If
    
    Me.listviewLibraryActivityList.ListItems(x).Checked = False
    
    Next x
    
    On Error GoTo 0

    Conn1.CommitTrans
    Conn1.Close
    
    Set Conn1 = Nothing
    Set rs = Nothing

    Exit Sub
    
ErrorHandler:
    MsgBox "Error number = " & (Err.Number - vbObjectError) & vbNewLine & Err.Description
    Conn1.RollbackTrans
    Conn1.Close
    
End Sub

 

[shknbk2]

Try this:

tagArray = Split(Me.TreeView1.SelectedItem.Tag, ",")

 

[bhalbach]

Try this:

tagArray = Split(Me.TreeView1.SelectedItem.Tag, ",")

I get a error 2147221513 subscript out of range.

'Is this correct?
Set n = Me.TreeView1.Nodes.Add(keyBidItem, tvwChild, keyActivity, nodeText)
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")

'Calling it this way
cmd.Parameters("@BidItemID").Value = tagArray(0)
cmd.Parameters("@BidItemNo").Value = tagArray(2)

 

[shknbk2]

'Is this correct?

I think so.

When the code error happens, what are the values in tagArray, and what are you expecting them to be?