將查詢導出到Excel並將數據放入表MS Access 2013 VBA

Question

我已經能夠將查詢從MS Access導出到Excel工作簿並自動設置列寬和其他設置的格式，但是我無法找到如何將這些數據放入表中。 我發現創建表的命令是這樣的：

Sheet1.ListObjects.Add(xlSrcRange, Range("A1:D10"), , xlYes).Name = "myTable1"

但這就是對表的大小進行硬編碼。 由於我要導出多個查詢，因此我希望有一個模塊化的功能，該功能可以接受不同列/行長度的查詢，並為所有查詢創建表，而無需手動鍵入大小。 這是我的一些代碼：

Private Sub dumpQueries(path As String)

    Dim obj As AccessObject, dB As Object
    Set dB = Application.CurrentData
    For Each obj In dB.AllQueries
        testBool = InStr(obj.name, "Sys")
        If testBool <> True Then
            If obj.name = "example1" Or obj.name = "example2" Then
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, obj.name, path, True, editWorksheetName(obj.name)
            End If
        End If
    Next obj

End Sub


Private Sub formatFile(path As String)

Dim Date1 As Date, strReportAddress As String
Dim objActiveWkb As Object, appExcel As Object
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range

Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = False
appExcel.Application.Workbooks.Open (path)

Set objActiveWkb = appExcel.Application.ActiveWorkbook
With objActiveWkb
    Dim i As Integer
    For i = 1 To .Worksheets.count
        .Worksheets(i).Select
        Set sht = Worksheets(i)
        Set StartCell = Range("A1")
        .Worksheets(i).Cells.Select
        .Worksheets(i).Cells.EntireColumn.AutoFit
        .Worksheets(i).UsedRange
        LastRow = StartCell.SpecialCells(xlCellTypeLastCell).Row
        LastColumn = StartCell.SpecialCells(xlCellTypeLastCell).Column
        sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
    Next
End With

appExcel.ActiveWindow.TabRatio = 0.7
objActiveWkb.Close savechanges:=True
appExcel.Application.Quit
Set objActiveWkb = Nothing: Set appExcel = Nothing

End Sub

還有很多代碼，但這是相關的東西。 這是我創建excel文件並格式化它們的地方。 知道如何將這些數據直接放入表中嗎？

更新：我修復了我遇到的所有錯誤，但仍然無法創建包含所有數據的表。 我在上面編輯了我的代碼以進行完全更新。

解決了這個問題，但是出現了一個新問題。 如果可以幫助，請轉到VBA運行時錯誤1004：嘗試在Excel 2013中創建表時，對象_Global的方法范圍失敗 。

Answer 1

考慮使用QueryTables並指定左上角目標和特定查詢。 下面是Excel VBA代碼，您可以通過ODBC從外部Access數據庫中導入該代碼：

Dim constr As String

constr = "ODBC;DRIVER=Microsoft Access Driver (*.mdb, *.accdb);" _
           & "DBQ=C:\Path\To\Database\File.accdb;"

With ActiveSheet.ListObjects.Add(SourceType:=0, _
                                 Source:=constr, _
                                 Destination:=Range("$A$1")).QueryTable

     .CommandText = "SELECT * FROM [Table]" 
     .ListObject.DisplayName = "TableName" 
     .Refresh BackgroundQuery:=False 
End With

Answer 2

您可以嘗試使用ODBC查詢嗎？ 查看下面的鏈接，看看是否能滿足您的需求。

http://translate.google.pl/translate?js=n&prev=_t&hl=pl&ie=UTF-8&layout=2&eotf=1&sl=pl&tl=zh_CN&u=http%3A%2F%2Fafin.net%2FKsiazkaSQLwExcelu%2FGraficznyEdytorsapytanSqlNaPrzy。