将查询导出到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。