Private Sub cmdExport_Click()
    Dim i As Integer, r As Integer, c As Integer
    Dim newxls As Excel.Application
    Dim newbook As Excel.Workbook
    Dim newsheet As Excel.Worksheet
    Set newxls = CreateObject("Excel.Application") '打开excel应用程序
    Set newbook = newxls.Workbooks.Add   '创建工作簿
    Set newsheet = newbook.Worksheets(1) '创建工作表
    If sql <> "" Then
        Adodc1.RecordSource = sql
        Adodc1.Refresh
    End If
    If Adodc1.Recordset.RecordCount > 0 Then
        newsheet.Cells.CopyFromRecordset Adodc2.Recordset  '复制表单中的数据
        Dim myval As Long
        Dim mystr As String
            mystr = InputBox("请输入文件名称", "导出文件名")
            If Len(mystr) = 0 Then
                Exit Sub
            End If
            On Error GoTo ErrSave
            newsheet.SaveAs App.Path & "\Excel文件\" & mystr & ".xls"
            MsgBox "Excel文件导出成功!位置:" & App.Path & "\Excel文件\" & mystr & ".xls", , "提示窗口"
            newxls.Quit
    Else
            MsgBox "没有需要导出的数据,Excel文件导出失败!", , "提示窗口"
    End If
End Sub
上面代码可以实现导出excel表，但不能导出表头，请各位高手们给个方子。谢谢啦！

复制完数据后，插入一行，然后再把字段名 一个一个的写进去。

我一般都是先写入一行然后
newsheet.Cells（2,1）.CopyFromRecordset Adodc2.Recordset  '复制表单中的数据