將查詢導出到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 Run-time error 1004: Method Range of object _Global failed when trying to create tables in Excel 2013。

Answer 1

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

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=en&u=http%3A%2F%2Fafin.net%2FKsiazkaSQLwExcelu%2FGraficznyEdytorZapytanSqlNaPrzykladzieMsQuery.htm