TreeView2Text .CLS


Allows to save the contents of TreeView in a file text and to read again it afterward to fill another TreeView

( Sources converts in 6 colours with my VB TO HTML program)

 

Dim FSO As FileSystemObject
Dim TXTstream As TextStream

'==================================================================================
'   Save Nodes in a Text file
'==================================================================================
Public Sub SaveTreeViewinFile(ByVal TV As TreeView, ByVal FileName As String)
    Dim i As Long
    Dim tempo As String
    Dim Neu As Node

    On Error Resume Next

    Set TXTstream = FSO.CreateTextFile(FileName)
    If Err.Number <> 0 Then GoTo gestion_erreur

    For i = 1 To TV.Nodes.Count
        Set Neu = TV.Nodes(i)

        tempo = Neu.Text + Chr(9) + _
                CStr(Neu.Parent.Key) + Chr(9) + _
                Neu.Key + Chr(9) + _
                CStr(Neu.Image) + Chr(9) + _
                CStr(Neu.Selectedimage) + Chr(9) + _
                Neu.tag

        If Err.Number <> 0 Then ' if no parent
            tempo = Neu.Text + Chr(9) + _
                    "" + Chr(9) + _
                    Neu.Key + Chr(9) + _
                    CStr(Neu.Image) + Chr(9) + _
                    CStr(Neu.Selectedimage) + Chr(9) + _
                    Neu.tag
            Err.Clear
        End If
        
        TXTstream.WriteLine tempo
    Next i
    TXTstream.Close

    Exit Sub
gestion_erreur:
    MsgBox Err.Description, vbCritical, "ERREUR n" & CStr(Err.Number)
End Sub

'==================================================================================
'   Load Nodes from a text file to a TreeView
'==================================================================================
Public Sub LoadTreeViewFromFile(ByVal TV As TreeView, ByVal FileName As String)

    Dim LigneTexte As String
    Dim Texte As String
    Dim Parent As String
    Dim Key As String
    Dim Image As String
    Dim Selectedimage As String
    Dim tag As String


    On Error GoTo gestion_erreur

    TV.Nodes.Clear
    Set TXTstream = FSO.OpenTextFile(FileName)

    Do
        LigneTexte = TXTstream.ReadLine

        Texte = Mid(LigneTexte, 1, InStr(1, LigneTexte, Chr(9), vbTextCompare) - 1)
        LigneTexte = Replace(LigneTexte, Texte + Chr(9), "", , 1)

        If Mid(LigneTexte, 1, 1) = Chr(9) Then
            Parent = 0
            LigneTexte = Mid(LigneTexte, 2)
        Else
            Parent = (Mid(LigneTexte, 1, InStr(1, LigneTexte, Chr(9), vbTextCompare) - 1))
            LigneTexte = Replace(LigneTexte, CStr(Parent) + Chr(9), "", , 1)
        End If

        Key = Mid(LigneTexte, 1, InStr(1, LigneTexte, Chr(9), vbTextCompare) - 1)
        LigneTexte = Replace(LigneTexte, Key + Chr(9), "", , 1)

        Image = Mid(LigneTexte, 1, InStr(1, LigneTexte, Chr(9), vbTextCompare) - 1)
        LigneTexte = Replace(LigneTexte, Image + Chr(9), "", , 1)

        Selectedimage = Mid(LigneTexte, 1, InStr(1, LigneTexte, Chr(9), vbTextCompare) - 1)
        LigneTexte = Replace(LigneTexte, Selectedimage + Chr(9), "", , 1)

        tag = LigneTexte

        If Selectedimage = "" Then Selectedimage = Image

        If Parent <> "0" Then
            If Image <> "" Then
                TV.Nodes.Add Parent, 4, Key, Texte, CLng(Image), CLng(Selectedimage)
            Else
                TV.Nodes.Add Parent, 4, Key, Texte
            End If
        Else
            If Image <> "" Then
                TV.Nodes.Add , , Key, Texte, CLng(Image), CLng(Selectedimage)
            Else
                TV.Nodes.Add , , Key, Texte
            End If
        End If

    Loop Until TXTstream.AtEndOfStream

    TXTstream.Close

    Exit Sub
gestion_erreur:
    MsgBox Err.Description, vbCritical, "ERREUR n" & CStr(Err.Number)
End Sub

'==================================================================================
'
'==================================================================================
Private Sub Class_Initialize()
    Set FSO = New FileSystemObject
End Sub

'==================================================================================
'
'==================================================================================
Private Sub Class_Terminate()
    Set FSO = Nothing
    Set TXTstream = Nothing
End Sub