Option Explicit Dim Cnn As ADODB.Connection Dim Rst As ADODB.Recordset Const accmdselectallrecords = &H6D Const accmdcopy = &HBE Const acCmdClose = &H3A Const acEdit = 1 Const acNormal = 0 Const Target As String = "E:\bbsj.mdb" '这是我想实现的功能,生成新汇总表并在其基础上生成查询,导出到电子表中 Private Sub CommandButton1_Click() Dim accessobject As Object Set accessobject = CreateObject("access.application") accessobject.docmd.OpenQuery "汇总生成法人部分", acNormal, acEdit accessobject.docmd.OpenQuery "汇总表追加个人部分", acNormal, acEdit accessobject.docmd.OpenQuery "查询1" accessobject.docmd.runcommand.accmdselectallrecords accessobject.docmd.runcommand.accmdcopy accessobject.docmd.runcommand.acCmdClose AppActivate "Microsoft Excel - 利率清单.xls" Worksheets("浮动表1").Range("a1").Select ActiveSheet.PasteSpecial End Sub ’这是我用来测试是否能从access中取出查询结果到电子表中 Private Sub CommandButton2_Click() Dim Stpath As String Dim strSQL As String Set Cnn = New ADODB.Connection Set Rst = New ADODB.Recordset Stpath = ThisWorkbook.Path & "\bbsj.mdb" Cnn.Open "provider=Microsoft.jet.OLEDB.4.0;data source=" & Stpath & ";Jet OLEDB:Database Password=" & "123" strSQL = "SELECT * FROM 查询1 " Rst.Open strSQL, Cnn Worksheets("浮动表1").Range("A2:BB1000").ClearContents Worksheets("浮动表1").Range("A2:BB1000").CopyFromRecordset Rst Rst.Close Set Rst = Nothing Set Cnn = Nothing End Sub |