把多个查询结果导出到同一个Excel表的代码

例如：

Private Sub Command16_Click()

    On Error GoTo er
    Dim xlApp As New Excel.Application'引用excel
    Dim xlBk As Excel.Workbook
    Dim xlSt As Excel.Worksheet
    Const tbs As String = "表1,表2,表3"   '这里更改为你要要导出的表或查询的名称集，用英文逗号分隔
    Dim ary
    Dim k, m
    Dim Rec As ADODB.Recordset '引用ado
    Set xlBk = xlApp.Workbooks.Add
    xlApp.Visible = True
    ary = Split(tbs, ",")
    For k = 0 To UBound(ary)
        Set Rec = New ADODB.Recordset
        Rec.Open "SELECT * FROM " & ary(k), LCn, adOpenStatic, adLockReadOnly
        '  If Rec.RecordCount > 0 Then
        Set xlSt = xlBk.Worksheets.Add(after:=xlBk.Worksheets(xlBk.Worksheets.count))
        With xlSt
            For m = 1 To Rec.Fields.count
                .Cells(1, m) = Rec.Fields(m - 1).Name
            Next m
            .Cells(2, 1).CopyFromRecordset Rec
            .Name = ary(k)
        End With
        '  End If
    Next k
    Exit Sub
er:
    '’...
End Sub