Excel VBA：ActiveSheet.ListObjects.Add从多个资源添加到同一个工作表中一个表不能重叠错误

Question

我在Excel工作表中有一个VBA脚本， 它＆＃39;基本上从访问数据库查询一些数据，如下所示：

 With ActiveSheet
            Set x = .ListObjects.Add(SourceType:=0, Source:=Array(Array("ODBC;DSN=MS Access Database;DBQ=" & dname & ";DefaultDi"), Array("r=I:\Pems Filter\Pems Filter\AccessDatabase;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;")), Destination:=Range("$A$1")).QueryTable

            With x
            .CommandText = Array( _
            "SELECT newTable.Field1, newTable.Field2, newTable.Field3, newTable.Field4, newTable.Field5, newTable.Field6, newTable.Field7, newTable.Field8, newTable.Field9, newTable.Field10, newTable.Field11, newT" _
            , _
            "able.Field12, newTable.Field13, newTable.Field14, newTable.Field15, newTable.Field16, newTable.Field17, newTable.Field18, newTable.Field19, newTable.Field20, newTable.Field21, newTable.Field22, newTab" _
            , _
            "le.Field23, newTable.Field24, newTable.Field25" & Chr(13) & "" & Chr(10) & "FROM newTable newTable" & Chr(13) & "" & Chr(10) & "WHERE (newTable.Field2=" & detectorid & ")" _
            )
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = False
            .ListObject.DisplayName = "Table_Query_from_MS_Access_Database_1"
            .Refresh BackgroundQuery:=False
            End With
        End With

这里的问题是，我有多个Access数据库，每个数据库都有完全相同的表，我试图建立一个循环，我对这样的Access数据库列表执行此查询，如下所示：

For i = 1 To Application.CountA(listDatabases)
    dname = databasename & "\" & listDatabases(i)

    With ActiveSheet
            Set x = .ListObjects.Add(SourceType:=0, Source:=Array(Array("ODBC;DSN=MS Access Database;DBQ=" & dname & ";DefaultDi"), Array("r=I:\Pems Filter\Pems Filter\AccessDatabase;DriverId=25;FIL=MS Access;MaxBufferSize=2048;PageTimeout=5;")), Destination:=Range("$A$1")).QueryTable

            With x
            .CommandText = Array( _
            "SELECT newTable.Field1, newTable.Field2, newTable.Field3, newTable.Field4, newTable.Field5, newTable.Field6, newTable.Field7, newTable.Field8, newTable.Field9, newTable.Field10, newTable.Field11, newT" _
            , _
            "able.Field12, newTable.Field13, newTable.Field14, newTable.Field15, newTable.Field16, newTable.Field17, newTable.Field18, newTable.Field19, newTable.Field20, newTable.Field21, newTable.Field22, newTab" _
            , _
            "le.Field23, newTable.Field24, newTable.Field25" & Chr(13) & "" & Chr(10) & "FROM newTable newTable" & Chr(13) & "" & Chr(10) & "WHERE (newTable.Field2=" & detectorid & ")" _
            )
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = False
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .PreserveColumnInfo = False
            .ListObject.DisplayName = "Table_Query_from_MS_Access_Database_1"
            .Refresh BackgroundQuery:=False
            End With
        End With
Next i

但没有希望，我不断收到这个错误：

任何解决方案？