Private Sub Excel3_Click()mvarVersion = vbLBV5
Dim SaveFilePath As String
Dim EXEString As String
Dim I As Integer, j As Integer
Dim InsertAmount As Integer
Dim WS As DAO.Workspace
Dim DB As DAO.Database
Dim TABL As DAO.TableDef
Dim RS As DAO.Recordset
On Error GoTo err_handleWith Frm_config.CommonDialog1
    .CancelError = False
    .Filter = "Excel文件(*.xls)|*.xls"
    .DialogTitle = "将数据导出到Excel表(5.0)"
    .ShowOpen
    If Trim(.FileName) = "" Then
     Exit Sub
    End If
    
    SaveFilePath = .FileName
End With
If Frm_config.ListView1.ColumnHeaders.Count <= 0 Then
 Exit Sub
End If
Set WS = DBEngine.CreateWorkspace("WS", "Admin", "", dbUseJet)
Kill App.Path & "\report\listviewToExcel.mdb"
Set DB = WS.CreateDatabase(App.Path & "\report\listviewToExcel.mdb", dbLangGeneral, dbEncrypt)
Set TABL = DB.CreateTableDef("Excel")
For I = 1 To Frm_config.ListView1.ColumnHeaders.Count
    TABL.Fields.Append TABL.CreateField(Frm_config.ListView1.ColumnHeaders.Item(I).Text, dbText, 250)
Next I
DB.TableDefs.Append TABL
Set RS = DB.OpenRecordset("Excel")
If Frm_config.ListView1.ListItems.Count > 0 Then
    If Frm_config.ListView1.ColumnHeaders.Count >= (Frm_config.ListView1.ListItems.Item(1).ListSubItems.Count + 1) Then
        InsertAmount = Frm_config.ListView1.ListItems.Item(1).ListSubItems.Count + 1
    Else
        InsertAmount = Frm_config.ListView1.ColumnHeaders.Count
    End If
    For I = 1 To Frm_config.ListView1.ListItems.Count
        RS.AddNew
        RS.Fields(0) = Frm_config.ListView1.ListItems.Item(I).Text
        For j = 1 To InsertAmount - 1
            If Frm_config.ListView1.ListItems.Item(I).ListSubItems.Item(j).Text <> "" Then
             RS.Fields(j) = Frm_config.ListView1.ListItems.Item(I).ListSubItems.Item(j).Text
            Else
             RS.Fields(j) = 0
            End If
        Next j
        RS.Update
    Next I
End If
EXEString = "select * into [Excel " & Format(CStr(mvarVersion), "0.0") & ";database=" & SaveFilePath & "].LBExcel from Excel"
DB.Execute EXEString
RS.Close
DB.Close
WS.Close
Kill App.Path & "\report\listviewToExcel.mdb"MsgBox "导出数据到Excel表成功!", vbInformation, "提示"
Exit Sub
err_handle:
Select Case Err
    Case 53:
        Resume Next
End Select
End Sub