Acess Treeview change Parent Node Color

[Smartacus]

Does anyone know how to update the parent node text of a child node after the child meets criteria that would require it to be flagged or change the forecolor?

What I am doing is evaluating the child node when created. For instance if the child node representing an Invoice is "Open" or equals "O" I am changing the forecolor to blue to make it more pronounced .

What I would also like to do is update the parent node also by changing it's color and possibly expanding the node also.

[Smartacus]

Once again with some piece work I have achieved what I wanted.

Here is an example of a complete Treeview in Access VBA that will help you setup a nice tree view with some changes only needed in you SQL and Connection properties. This example has a MSSQL DB.

In Form Load or a button
Call SetupTreeview
Call Load_Treeview
Call xtree_Children

Private Sub Load_Treeview()
'Call SetupTreeview
    On Error GoTo Error
    Dim tvx As MSComctlLib.TreeView
    Set tvx = xtree.Object

    Dim strSQLA As String
    Dim strKeyParent As String
    Dim strParentRow As String
    Dim rsClients As New ADODB.Recordset
    Set Con = Application.CurrentProject.Connection
    
    strSQLA = "select Clientid, ClientName,BillingCode,fcActive, Count(ServiceID) as Session_Count " & _
              "from vARreconcile Where ProgramNumber = " & cbProgram.SelText & " AND fcActive = 1 Group by ClientID,ClientName,BillingCode,fcActive"

    rsClients.Open strSQLA, Con, adOpenStatic
    tvx.Nodes.Clear
    rsClients.MoveFirst
    Do
        ' Create the Unique Key for each Client Row
        strKeyParent = "CL=" & rsClients!clientid
        strParentRow = rsClients!clientid & " - " & rsClients!ClientName & " (" & rsClients!Session_Count & ")"

        ' add ClientID Row as Parent with key
        With Me.xtree.Nodes.Add(Text:=strParentRow, Key:=CStr(strKeyParent))

            If rsClients!fcActive = False Then
                .ForeColor = vbGrayText
            End If
        End With
        rsClients.MoveNext

    Loop Until rsClients.EOF

UserForm_Initialize_Exit:
    On Error Resume Next
    rsClients.Close
    Con.Close
    Set rsClients = Nothing
    Set Con = Nothing
    Exit Sub
Error:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    Resume UserForm_Initialize_Exit
End Sub

Private Sub xtree_Children()
    On Error GoTo Error

    Dim strSQLB As String
    Dim strRelative As String
    Dim strKeyChild As String
    Dim strChildRow As String
    Dim strBillStatus
    Dim rsService As New ADODB.Recordset

    Dim tvx As MSComctlLib.TreeView

    Set Con = Application.CurrentProject.Connection
    strSQLB = "Select Distinct ServiceID,clientid, [Date],BillingCode from vARreconcile Where ProgramNumber = " & cbProgram.SelText

    rsService.Open strSQLB, Con, adOpenStatic
    rsService.MoveLast
    rsService.MoveFirst

    Do Until rsService.EOF
        'The parent key of the top level node
        strRelative = CStr("CL=" & rsService!clientid)
        'Create the Unique Key for each Service Row
        strKeyChild = CStr("SI=" & rsService!ServiceId)
        'This is the billing code
        strBillStatus = IIf(IsNull(rsService!BillingCode), "x", Trim(rsService!BillingCode))
        'Set the text for the child node
        strChildRow = CStr(rsService!ServiceId) & " - " & CStr(Format(rsService![Date], "MM/dd/yyyy")) & " - " & strBillStatus

        If strBillStatus = "O" Then    ' Open
            With Me.xtree.Nodes.Add(Relationship:=tvwChild, _
                                    Relative:=strRelative, _
                                    Key:=strKeyChild, Text:=strChildRow)
                'Sets this (child node) color
                .ForeColor = vbBlue
                'Sets the Parent node color
                .Parent.ForeColor = vbBlue
                'Sets the Parent node to Bold
                .Parent.Bold = True
                'Sets the Parent node to Expanded
                .Parent.Expanded = True


            End With

        Else

            With Me.xtree.Nodes.Add(Relationship:=tvwChild, _
                                    Relative:=strRelative, _
                                    Key:=strKeyChild, Text:=strChildRow)
                .ForeColor = vbBlack
            End With

        End If
        rsService.MoveNext
    Loop

UserForm_Initialize_Exit:
    On Error Resume Next
    rsService.Close
    Con.Close
    Set rsService = Nothing
    Set Con = Nothing
    Exit Sub
Error:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error!"
    Resume UserForm_Initialize_Exit
End Sub

Private Sub SetupTreeview()
    With Me.xtree
        .Style = tvwTreelinesPlusMinusText
        .LineStyle = tvwRootLines
        .Indentation = 240
        .Appearance = ccFlat
        .HideSelection = False
        .BorderStyle = ccFixedSingle
        .HotTracking = False
        .FullRowSelect = True
        .Checkboxes = False
        .SingleSel = False
        .Sorted = False
        .Scroll = True
        .LabelEdit = tvwManual
        .Font.NAME = "Verdana"
        .Font.Size = 9
    End With
End Sub