vb 实现导出excel首先要在工程中引用Microsoft Excel 11.0 Object Library库或者其他版本，操作数据库则可以引用Microsoft ActiveX Data Objects 2.0 Library库

代码如下：

Dim Con As New ADODB.Connection
Dim Res As New ADODB.Recordset
'从listview中导出excel文件
Private Sub CmdExcel_Click()
    Dim VBExcel    As Excel.Application      '定义Excel服务器应用程序
    Dim ExcelBook  As Excel.Workbook       '定义Excel工作簿对象
    Dim ExcelSheet As Excel.Worksheet     '定义Excel工作表对象
   
    Set VBExcel = CreateObject("Excel.Application")         '创建一个Excel应用程序
    VBExcel.Visible = True       '可见
   
    Set ExcelBook = VBExcel.Workbooks.Add         '添加Excel工作簿
    Set ExcelSheet = ExcelBook.Worksheets("Sheet1")         '添加工作表
   
    '指定Excel表的列宽
    ExcelSheet.Columns.ColumnWidth = 13
With ListView_Show '所打开的记录集对象
   Dim i, j, k As Integer
   For i = 1 To .ColumnHeaders.Count
   ExcelSheet.Cells(1, i).Value = .ColumnHeaders(i)
   Next
       For j = 1 To .ListItems.Count
          ExcelSheet.Cells(j + 1, 1).Value = .ListItems(j).Text
          For k = 1 To .ColumnHeaders.Count - 1
              ExcelSheet.Cells(j + 1, k + 1).Value = .ListItems(j).ListSubItems(k)
          Next
       Next
    ExcelBook.SaveAs (App.Path & "myExcel.xlsx")
    ExcelBook.RunAutoMacros (1)
    ExcelBook.RunAutoMacros (2)
    VBExcel.Quit
    Set VBExcel = Nothing
    Set ExcelBook = Nothing
    Set ExcelSheet = Nothing
   
End With

End Sub
'从数据库中直接导出Excel文件
Private Sub Command1_Click()
    Dim VBExcel    As Excel.Application      '定义Excel服务器应用程序
    Dim ExcelBook  As Excel.Workbook       '定义Excel工作簿对象
    Dim ExcelSheet As Excel.Worksheet     '定义Excel工作表对象
   
    Set VBExcel = CreateObject("Excel.Application")         '创建一个Excel应用程序
    VBExcel.Visible = True       '可见
   
    Set ExcelBook = VBExcel.Workbooks.Add         '添加Excel工作簿
    Set ExcelSheet = ExcelBook.Worksheets("Sheet1")         '添加工作表
   
    '指定Excel表的列宽
    ExcelSheet.Columns.ColumnWidth = 13
   
    Dim intCol As Long
    Dim intRow As Long
   
    ExcelSheet.Cells(1, 1).Value = "名称"
    ExcelSheet.Cells(1, 2).Value = "数量"
    ExcelSheet.Cells(1, 3).Value = "单价"
    ExcelSheet.Cells(1, 4).Value = "总价"
   
    Dim strsql As String
    strsql = &