ListView2Text .CLS

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

 

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Dim FSO As FileSystemObject
Dim TXTstream As TextStream

'==================================================================================
'   Save lines of a ListView in a Text File
'   This File can be open with Excel (see Sub OpenListViewFileInExcel)
'==================================================================================
Public Sub SaveListViewInFile(ByVal LV As ListView, ByRef FileName As String)
    Dim i As Long
    Dim j As Long
    Dim tempo As String

    On Error GoTo gestion_erreur

    Set TXTstream = FSO.CreateTextFile(FileName)

    For i = 1 To LV.ListItems.Count
        tempo = LV.ListItems.Item(i).Text
        For j = 1 To LV.ColumnHeaders.Count - 1
            tempo = tempo & Chr(9) & LV.ListItems.Item(i).SubItems(j)
        Next j
        TXTstream.WriteLine tempo
    Next i

    TXTstream.Close

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

'==================================================================================
'   Load Lines from a file to a ListView
'==================================================================================
Public Sub LoadListViewFromFile(ByVal LV As Object, ByRef FileName As String)
    Dim i As Long
    Dim j As Long
    Dim NbLigne As Long
    Dim NbColonne As Long
    Dim LigneTexte
    Dim ColonneTexte As String

    On Error GoTo gestion_erreur

    LV.ListItems.Clear

    Set TXTstream = FSO.OpenTextFile(FileName)
    i = 1
    j = 1

    Do
        LigneTexte = TXTstream.ReadLine
        ColonneTexte = Mid(LigneTexte, 1, InStr(1, LigneTexte, Chr(9), vbTextCompare) - 1)
        LigneTexte = Replace(LigneTexte, ColonneTexte + Chr(9), "", , 1)
        LV.ListItems.Add , , ColonneTexte

        While InStr(1, LigneTexte, Chr(9), vbTextCompare) <> 0
            If LV.ColumnHeaders.Count <= j Then LV.ColumnHeaders.Add , , j
            ColonneTexte = Mid(LigneTexte, 1, InStr(1, LigneTexte, Chr(9), vbTextCompare) - 1)
            LV.ListItems.Item(i).SubItems(j) = ColonneTexte
            LigneTexte = Replace(LigneTexte, ColonneTexte + Chr(9), "", , 1)
            j = j + 1
        Wend

        If LV.ColumnHeaders.Count <= j Then LV.ColumnHeaders.Add , , j
        LV.ListItems.Item(i).SubItems(j) = LigneTexte

        j = 1
        i = i + 1

    Loop Until TXTstream.AtEndOfStream

    TXTstream.Close

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


'==================================================================================
'   Open a ListView File with Excel
'==================================================================================
Public Sub OpenListViewFileInExcel(ByVal FileName As String)
    On Error Resume Next
    Call ShellExecute(0, "open", "excel", """" & FileName & """", "", 10)
End Sub

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

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