export listview to excel

sal21 · Post by **sal21** » 22 Apr 2020, 20:55

Private Sub Command2_Click()

    Screen.MousePointer = vbHourglass

    Dim objXcell As Object
    Dim objWbook As Object
    Dim objSheet As Object
    Set objXcell = CreateObject("Excel.Application")

    Set objWbook = objXcell.Workbooks.Add
    Set objSheet = objWbook.Worksheets.Add

    With objSheet
        If Dir("C:\dream2000\EXPORT\AAA.xls") <> "" Then
            Kill "C:\dream2000\EXPORT\AAA.xls"
        End If

        Dim lngCounter As Long

        With Me.ListView1
            For lngCounter = 1 To .ListItems.Count

                objSheet.Cells(lngCounter, 1).Value = .ListItems(lngCounter).Text
                objSheet.Cells(lngCounter, 2).Value = .ListItems(lngCounter).SubItems(1)

            Next
        End With
        .SaveAs "C:\dream2000\EXPORT\AAA.xls"
    End With

    Me.LAZIONI.Caption = "EXPORT TERMINATO!"
    DoEvents
    Sleep (1500)
    Me.Text.SetFocus
    Me.LAZIONI.Caption = ""
    DoEvents

    objWbook.Close False
    Set objSheet = Nothing
    Set objWbook = Nothing
    objXcell.Quit
    Set objXcell = Nothing

    Screen.MousePointer = vbDefault

End Sub

my poor code.

but really i need to:
1) insert the name pf item from listview as title of column in sheet
2) for test the code work only with two item of listview, i need to loop all item in listview

Post by **HansV** » 22 Apr 2020, 21:22

Like this:

Code: Select all

Private Sub Command2_Click()
    Const strFile = "C:\dream2000\EXPORT\AAA.xls"
    Dim objXcell As Object
    Dim objWbook As Object
    Dim objSheet As Object
    Dim lngRowCounter As Long
    Dim lngColCounter As Long

    Set objXcell = CreateObject("Excel.Application")

    Screen.MousePointer = vbHourglass

    If Dir(strFile) <> "" Then
        Kill strFile
    End If

    Set objWbook = objXcell.Workbooks.Add(-4167)
    Set objSheet = objWbook.Worksheets(1)

    With Me.ListView1
        For lngColCounter = 1 To .ColumnHeaders.Count
            objSheet.Cells(1, lngColCounter).Value = .ColumnHeaders(lngColCounter).Text
        Next lngColCounter

        For lngRowCounter = 1 To .ListItems.Count
            objSheet.Cells(lngRowCounter + 1, 1).Value = .ListItems(lngRowCounter).Text
            For lngColCounter = 2 To .ColumnHeaders.Count
                objSheet.Cells(lngRowCounter + 1, lngColCounter).Value = _
                    .ListItems(lngRowCounter).ListSubItems(lngColCounter - 1).Text
            Next lngColCounter
        Next lngRowCounter
    End With

    objSheet.UsedRange.EntireColumn.AutoFit

    objWbook.SaveAs strFile, 56
    objWbook.Close False
    objXcell.Quit
    Set objSheet = Nothing
    Set objWbook = Nothing
    Set objXcell = Nothing

    Me.LAZIONI.Caption = "EXPORT TERMINATO!"
    DoEvents
    Sleep 1500
    Me.Text.SetFocus
    Me.LAZIONI.Caption = ""
    DoEvents
End Sub

sal21 · Post by **sal21** » 24 Apr 2020, 08:01

HansV wrote:Like this:

Code: Select all

Private Sub Command2_Click()
    Const strFile = "C:\dream2000\EXPORT\AAA.xls"
    Dim objXcell As Object
    Dim objWbook As Object
    Dim objSheet As Object
    Dim lngRowCounter As Long
    Dim lngColCounter As Long

    Set objXcell = CreateObject("Excel.Application")

    Screen.MousePointer = vbHourglass

    If Dir(strFile) <> "" Then
        Kill strFile
    End If

    Set objWbook = objXcell.Workbooks.Add(-4167)
    Set objSheet = objWbook.Worksheets(1)

    With Me.ListView1
        For lngColCounter = 1 To .ColumnHeaders.Count
            objSheet.Cells(1, lngColCounter).Value = .ColumnHeaders(lngColCounter).Text
        Next lngColCounter

        For lngRowCounter = 1 To .ListItems.Count
            objSheet.Cells(lngRowCounter + 1, 1).Value = .ListItems(lngRowCounter).Text
            For lngColCounter = 2 To .ColumnHeaders.Count
                objSheet.Cells(lngRowCounter + 1, lngColCounter).Value = _
                    .ListItems(lngRowCounter).ListSubItems(lngColCounter - 1).Text
            Next lngColCounter
        Next lngRowCounter
    End With

    objSheet.UsedRange.EntireColumn.AutoFit

    objWbook.SaveAs strFile, 56
    objWbook.Close False
    objXcell.Quit
    Set objSheet = Nothing
    Set objWbook = Nothing
    Set objXcell = Nothing

    Me.LAZIONI.Caption = "EXPORT TERMINATO!"
    DoEvents
    Sleep 1500
    Me.Text.SetFocus
    Me.LAZIONI.Caption = ""
    DoEvents
End Sub

Hummmmm.....

Possible to use a template.xls (WITHOUT OPEN IT) stored in C:\MYDIR\ to save the data from listview, and save in the same dir with this format name YYYYMMDD_HHMMSS.xls....

attached a template .xls

Post by **HansV** » 24 Apr 2020, 09:50

Code: Select all

Private Sub Command2_Click()
    Dim strFile As String
    Dim objXcell As Object
    Dim objWbook As Object
    Dim objSheet As Object
    Dim lngRowCounter As Long
    Dim lngColCounter As Long

    Set objXcell = CreateObject("Excel.Application")

    Screen.MousePointer = vbHourglass

    Set objWbook = objXcell.Workbooks.Add("C:\MyDir\Template.xls")
    Set objSheet = objWbook.Worksheets(1)

    With Me.ListView1
        For lngColCounter = 1 To .ColumnHeaders.Count
            objSheet.Cells(1, lngColCounter).Value = .ColumnHeaders(lngColCounter).Text
        Next lngColCounter

        For lngRowCounter = 1 To .ListItems.Count
            objSheet.Cells(lngRowCounter + 1, 1).Value = .ListItems(lngRowCounter).Text
            For lngColCounter = 2 To .ColumnHeaders.Count
                objSheet.Cells(lngRowCounter + 1, lngColCounter).Value = _
                    .ListItems(lngRowCounter).ListSubItems(lngColCounter - 1).Text
            Next lngColCounter
        Next lngRowCounter
    End With

    objSheet.UsedRange.EntireColumn.AutoFit

    strFile = "C:\MyDir\" & Format(Now, "yyyymmdd_hhmmss") & ".xls"
    objWbook.SaveAs strFile, 56
    objWbook.Close False
    objXcell.Quit
    Set objSheet = Nothing
    Set objWbook = Nothing
    Set objXcell = Nothing

    Me.LAZIONI.Caption = "EXPORT TERMINATO!"
    DoEvents
    Sleep 1500
    Me.Text.SetFocus
    Me.LAZIONI.Caption = ""
    DoEvents
End Sub

sal21 · Post by **sal21** » 24 Apr 2020, 10:22

HansV wrote:

Code: Select all

Private Sub Command2_Click()
    Dim strFile As String
    Dim objXcell As Object
    Dim objWbook As Object
    Dim objSheet As Object
    Dim lngRowCounter As Long
    Dim lngColCounter As Long

    Set objXcell = CreateObject("Excel.Application")

    Screen.MousePointer = vbHourglass

    Set objWbook = objXcell.Workbooks.Add("C:\MyDir\Template.xls")
    Set objSheet = objWbook.Worksheets(1)

    With Me.ListView1
        For lngColCounter = 1 To .ColumnHeaders.Count
            objSheet.Cells(1, lngColCounter).Value = .ColumnHeaders(lngColCounter).Text
        Next lngColCounter

        For lngRowCounter = 1 To .ListItems.Count
            objSheet.Cells(lngRowCounter + 1, 1).Value = .ListItems(lngRowCounter).Text
            For lngColCounter = 2 To .ColumnHeaders.Count
                objSheet.Cells(lngRowCounter + 1, lngColCounter).Value = _
                    .ListItems(lngRowCounter).ListSubItems(lngColCounter - 1).Text
            Next lngColCounter
        Next lngRowCounter
    End With

    objSheet.UsedRange.EntireColumn.AutoFit

    strFile = "C:\MyDir\" & Format(Now, "yyyymmdd_hhmmss") & ".xls"
    objWbook.SaveAs strFile, 56
    objWbook.Close False
    objXcell.Quit
    Set objSheet = Nothing
    Set objWbook = Nothing
    Set objXcell = Nothing

    Me.LAZIONI.Caption = "EXPORT TERMINATO!"
    DoEvents
    Sleep 1500
    Me.Text.SetFocus
    Me.LAZIONI.Caption = ""
    DoEvents
End Sub

Eileen's Lounge

export listview to excel

export listview to excel

Re: export listview to excel

Re: export listview to excel

Re: export listview to excel

Re: export listview to excel