Search Tools Links Login

Export ListView Contents to Excel

This will export the contents of a listview into a new Excel Workbook.

Original Author: Cierra Computers & Consulting



API Declarations

Reference the MS Excel Object


Public Sub ExportListViewtoExcel(lvwList As Control)
   Dim vntHeader As Variant
   Dim vntData As Variant
   Dim x As Long
   Dim y As Long
   Dim intCol As Integer
   Dim lngRow As Long
   'Get Counts
   intCol = CInt(lvwList.ColumnHeaders.Count - 1)
   lngRow = CLng(lvwList.ListItems.Count - 1)
   ReDim vntHeader(0)
   ReDim vntData(intCol, lngRow)
   'Create Header Array
   For x = 0 To intCol
     ReDim Preserve vntHeader(x)
     vntHeader(x) = lvwList.ColumnHeaders(x + 1).Text
   'Create Data Array
   For x = 0 To lngRow
    vntData(0, x) = lvwList.ListItems.Item(x + 1).Text
    For y = 1 To intCol
      vntData(y, x) = lvwList.ListItems.Item(x + 1).SubItems(y)
   'Create Excel Object
   OpenExcel vntData, vntHeader
End Sub
Private Sub ExportRecords(vntData As Variant, vntHeader As Variant, ws As Worksheet)
  Dim lngRow As Long
  Dim intCol As Integer
  Dim varData As Variant
  Dim intStart As Integer
  'Select all Cells and and set the number format to string
  ws.Cells.NumberFormat = "@"
  ws.Cells(1, 1).Select
  lngRow = UBound(vntData, 2) + 2
  intCol = UBound(vntData, 1) + 1
  intStart = 2  'Start from line 2
   'Freeze Row 2
   ActiveWindow.FreezePanes = True
   'Add Headers
   For x = 1 To intCol
      varData = vntHeader(x - 1)
      ws.Cells(1, x) = CStr(varData)
      ws.Cells(1, x).Font.Bold = True
  'Add Data
  For y = 1 To intCol
     For x = intStart To lngRow
        varData = vntData(y - 1, x - 2)
        If IsNull(varData) Then 'Make sure no null values, Excel will choke
             'Add 1 to Move down a column
          ws.Cells(x + 1, y) = ""
          ws.Cells(x + 1, y) = CStr(varData) 'Convert to String to preserve formatting
        End If
  'Resize Columns to Fit
End Sub
Private Sub OpenExcel(vntData As Variant, vntHeader As Variant)
On Error GoTo Err_OpenExcel
Dim objExcel As Excel.Application
Dim objWrkSht As Worksheet
Dim x As Integer
'Create Excel Object
Set objExcel = CreateObject("Excel.Application")
'Add the Workbook
Set objWrkSht = objExcel.ActiveWorkbook.Sheets(1)
objExcel.Visible = True
'Fill the Workbook with data
ExportRecords vntData, vntHeader, objWrkSht
objExcel.Interactive = True
' Clean up:
Set objExlSht = Nothing
Set objExcel = Nothing
   Select Case Err
     Case 0
     Case 439
        MsgBox "You must have Microsoft Excel installed on your PC.", vbCritical, "Application Not Found"
     Case Else
        MsgBox Err & ": " & Error, vbCritical, "OpenExcel Error"
   End Select
End Sub

About this post

Posted: 2002-06-01
By: ArchiveBot
Viewed: 172 times


Visual Basic 6


No attachments for this post

Loading Comments ...


No comments have been added for this post.

You must be logged in to make a comment.