有没有快速的方法，让listview里面的数据，导出到excel？

那只有把listview里面的数据保存导数组，然后打开excel，一个一个读到excel的单元格？
或者导出到文本文件，然后也是打开excel，一个一个单元格写入？？有没有其它好的办法

建议把原填充ListView的数据直接导出到Excel
ADO导出数据到Excel，推荐一篇老大写的文章
http://www.microsoft.com/china/community/Column/32.mspx

以上代码在我自己做的小软件中应用没问题，只是如果数据太多速度不太理想。
配合进度条控件，这样可防止用户认为程度死掉。我做的小软件： http://freehost26.websamba.com/zhanglan/show.asp?id=95

2.2 程式碼摘要Public Function dhListviewToExcel( _
    ByRef lvw As MSComctlLib.ListView, _
    ByVal strFileName As String, _
    Optional FileFormat As XlFileFormat = xlWorkbookNormal, _
    Optional blnHeaders As Boolean = True) As Boolean


    Dim intColCnt                       As Integer          ' 列之計數器。
    Dim intColumns                      As Integer          ' 欄位數。
    Dim intRowCnt                       As Integer          ' 欄之計數器。
    Dim intStartRow                     As Integer          ' 開始列數。
    Dim intVisibleColumns()             As Integer          ' 表頭資料。

    Dim itm                             As ListItem

    Dim lngResults                      As Long             ' 回傳數值。

    Dim objExcel                        As Excel.Application
    Dim objWorkbook                     As Excel.Workbook
    Dim objWorksheet                    As Excel.Worksheet
    Dim objRange                        As Excel.Range

    Dim strArray()                      As String           ' 表身資料。
    Dim strFileExtensionType            As String           ' 延伸檔名。

    '------------------------------------------------
    ' A0 偵測作業。
    '------------------------------------------------
    ' 判斷 listview 是否有資料。
    If lvw.SelectedItem Is Nothing Then
        MsgBox "表格沒有任何資料。", vbOKOnly + vbInformation, "匯出失敗"
        GoTo ExitFunction
    End If

    ' 詢問使用者匯出範圍。
    lngResults = MsgBox("只匯出選擇列數之資料？", vbYesNoCancel + vbQuestion + vbDefaultButton2, "匯出選擇列數")

    If lngResults = vbCancel Then
        GoTo ExitFunction
    End If

    Screen.MousePointer = vbHourglass

    ' 測試是否本機是否安裝 Excel。
    On Error Resume Next
    Set objExcel = New Excel.Application

    If Err.Number > 0 Then
        MsgBox "本機未安裝 MS Excel 。", vbOKOnly + vbCritical, "載入 Excel 失敗"
        GoTo ExitFunction
    End If

    '------------------------------------------------
    ' B0 Excel 相關設定作業。
    '------------------------------------------------
    On Error GoTo ExportToExcel_EH

    ' 不讓使用者操作。
    objExcel.Interactive = False    ' 背後作業。
    If objExcel.Visible = False Then
        objExcel.Visible = True
    End If

    ' 視窗最大化。
    objExcel.WindowState = xlMaximized    ' 設定 Wokkbook 物件。
    Set objWorkbook = objExcel.Workbooks.Add

    ' 設定 Worksheet 物件，指向 Sheet 1。
    Set objWorksheet = objWorkbook.Sheets(1)

    ' 設定 Range 物件，指向 Row 1。
    Set objRange = objWorksheet.Rows(1)

    ' 設定表頭字型大小、粗體。
    objRange.Font.Size = 9
    objRange.Font.Bold = True

    '------------------------------------------------
    ' C0 Excel 表頭部份相關設定作業。
    '------------------------------------------------
    For intColCnt = 1 To lvw.ColumnHeaders.Count

        If lvw.ColumnHeaders(intColCnt).Width <> 0 Then            intColumns = intColumns + 1

            ReDim Preserve intVisibleColumns(1 To intColumns)

            intVisibleColumns(intColumns) = intColCnt

            objRange.Cells(1, intColumns) = lvw.ColumnHeaders(intColCnt).Text

            With objWorksheet.Columns(intColumns)

                Select Case LCase(lvw.ColumnHeaders(intColCnt).Tag)
                    Case "string", ""
                        .NumberFormat = "@"
                    Case "number"
                        .NumberFormat = "#,##0.00_);(#,##0.00)"
                        .HorizontalAlignment = xlRight
                    Case "date"
                        .NumberFormat = "yyyy/mm/dd"
                        .HorizontalAlignment = xlRight
                End Select

            End With

        End If
    Next intColCnt

    '------------------------------------------------
    ' D0 取得 listview 資料，置入陣列。
    '------------------------------------------------
    ReDim strArray(1 To lvw.ListItems.Count, 1 To intColumns)

    intStartRow = 2

    For Each itm In lvw.ListItems

        If lngResults = vbNo Or itm.Selected Then

            intRowCnt = intRowCnt + 1

            For intColCnt = 1 To intColumns

                If intVisibleColumns(intColCnt) = 1 Then
                    strArray(intRowCnt, 1) = itm.Text
                Else
                    strArray(intRowCnt, intColCnt) = itm.SubItems(intVisibleColumns(intColCnt) - 1)
                End If
            Next intColCnt
        End If
    Next itm    '------------------------------------------------
    ' E0 陣列資料，置入 Excel。
    '------------------------------------------------
    With objWorksheet
        .Range(.Cells(2, 1), .Cells(2 + intRowCnt - 1, intColumns)) = strArray
    End With

    objWorksheet.Columns.AutoFit

    '------------------------------------------------
    ' F0 取得延伸檔名。
    '    參閱 Excel 說明裡的「Microsoft Excel 提供的檔案格式轉換器」
    '------------------------------------------------
    Select Case FileFormat
        Case xlSYLK
            strFileExtensionType = "slk"
        Case xlWKS
            strFileExtensionType = "wks"
        Case xlWK1, xlWK1ALL, xlWK1FMT
            strFileExtensionType = "wk1"
        Case xlCSV, xlCSVMac, xlCSVWindows
            strFileExtensionType = "csv"
        Case xlDBF2, xlDBF3, xlDBF4
            strFileExtensionType = "dbf"
        Case xlWorkbookNormal, xlExcel2FarEast, xlExcel3, xlExcel4, xlExcel4Workbook, xlExcel5, xlExcel7, xlExcel9795
            strFileExtensionType = "xls"
        Case xlHtml
            strFileExtensionType = "htm"
        Case xlTextMac, xlTextWindows, xlUnicodeText, xlCurrentPlatformText
            strFileExtensionType = "txt"
        Case xlTextPrinter
            strFileExtensionType = "prn"
        Case Else
            strFileExtensionType = "dat"
    End Select    '------------------------------------------------
    ' G0 另存檔案。
    '------------------------------------------------
    If InStr(1, strFileName, ".") = 0 Then

        ' 組合檔案名稱。
        strFileName = strFileName & "." & strFileExtensionType

        ' 另存檔案。
        objWorksheet.SaveAs strFileName, FileFormat

    End If

    '------------------------------------------------
    ' Z0 結束作業。
    '------------------------------------------------
    ' 關閉 Workbook。
    objWorkbook.Close

    ' 結束 Excel 作業。
    objExcel.Quit

    ' 載出物件變數。
    Set objRange = Nothing
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing

    ' 此處可以設定是否可以編輯 Excel。
'    objExcel.Interactive = True

    dhListviewToExcel = TrueExitFunction:    Screen.MousePointer = vbDefault

    Exit Function

ExportToExcel_EH:    ' 出現錯誤訊息。
    MsgBox "匯出失敗，原因如下：" & vbCrLf & vbCrLf & Err.Number & ": " & Err.Description, _
           vbOKOnly + vbCritical, "匯出失敗"

    ' 結束 Excel 作業。
    objExcel.Quit

    ' 載出物件變數。
    Set objRange = Nothing
    Set objWorksheet = Nothing
    Set objWorkbook = Nothing
    Set objExcel = Nothing

    GoTo ExitFunction

End Function

☆将listview的内容转到Excel☆

Sub OutPutExcel(sTitle As String, lvwList As ListView) ', Optional sAddCond As String = "", Optional XtChart As MSChart20Lib.MSChart)
'------------------------$$$$$$$ In Proc
  If lvwList.ListItems.Count = 0 Then GoTo ExitProc

  Screen.MousePointer = vbHourglass

'  On Error GoTo eerer

    Dim vbExcel As Object
    Dim vbWorkSheet As Object
    Dim RG As Object



    Set vbExcel = CreateObject("Excel.application")

    vbExcel.Workbooks.Add
    vbExcel.Sheets.Add
    Set vbWorkSheet = vbExcel.ActiveSheet
    vbWorkSheet.Name = "." & App.Title
    vbWorkSheet.Cells(1, 3).NumberFormatLocal = "@"
    vbWorkSheet.Cells(1, 3).Value = Trim(sTitle$)
    vbWorkSheet.Cells(1, 3).Font.Size = 15
    vbWorkSheet.Cells(1, 3).Font.Bold = True

    Dim rr%, kk%
    rr = 3
    If sAddCond <> "" Then
        vbWorkSheet.Cells(3, 2).NumberFormatLocal = "@"
        vbWorkSheet.Cells(3, 2).Value = Trim(sAddCond)
        rr = 4
    End If


  Dim LC&
  Dim LC1&
  Dim tlngAlign As Long

  For LC = 1 To lvwList.ColumnHeaders.Count
        With vbWorkSheet.Cells(rr, LC + 1)
            .NumberFormatLocal = "@"
            .Value = lvwList.ColumnHeaders(LC).Text
            .Font.Bold = True
            tlngAlign = lvwList.ColumnHeaders(LC).Alignment
            .HorizontalAlignment = Switch(tlngAlign = 0, &HFFFFEFDD, tlngAlign = 2, &HFFFFEFF4, tlngAlign = 1, &HFFFFEFC8)
            .VerticalAlignment = &HFFFFEFF4
        End With
  Next LC

  kk = 2
    For LC& = 1 To lvwList.ListItems.Count
        With vbWorkSheet.Cells(rr + LC, kk)
          .NumberFormatLocal = "@"
          tlngAlign = lvwList.ColumnHeaders(1).Alignment
          .HorizontalAlignment = Switch(tlngAlign = 0, &HFFFFEFDD, tlngAlign = 2, &HFFFFEFF4, tlngAlign = 1, &HFFFFEFC8)
          .VerticalAlignment = &HFFFFEFF4
          .Value = lvwList.ListItems(LC)
        End With
        For LC1 = 1 To lvwList.ColumnHeaders.Count - 1
              With vbWorkSheet.Cells(rr + LC, kk + LC1)
                .NumberFormatLocal = "@"
                tlngAlign = lvwList.ColumnHeaders(LC1 + 1).Alignment
                .HorizontalAlignment = Switch(tlngAlign = 0, &HFFFFEFDD, tlngAlign = 2, &HFFFFEFF4, tlngAlign = 1, &HFFFFEFC8)
                .VerticalAlignment = &HFFFFEFF4
                .Value = lvwList.ListItems(LC).SubItems(LC1)
              End With
        Next LC1
  Next LC&
    vbExcel.Visible = True
    vbWorkSheet.Activate    Set RG = Nothing
    Set vbExcel = Nothing
    Set vbWorkSheet = Nothing

    Screen.MousePointer = vbDefault
'sTitle 是标题, lvwList 是ListViewExitProc:
End Sub

回复内容：

回复人： lqtflwg718(九五之尊) ( ) 信誉：88  2004-6-29 20:37:33  得分: 0


楼上的，你的代码保存文件不知道去那儿了啊！能写个好一点的吗？
要能保存到用户选择路径的那种啊！

==========================晕！！楼主啊，putexcel 函数已经有个参数叫 strFile 了，你可以先用打开文件对话框取得该值，再调用 putexcel 即可。
看了我给你的地址上的软件没有？那个软件难道不能选择保存路径？总不能将显示文件对话框封装到 putexcel 函数中吧？那不符合模块化的规则。

调试易

有没有快速的方法，让listview里面的数据，导出到excel？

解决方案 »