错误 3011 - 将表传输到 Excel 工作簿

Question

我一直试图让这个编码工作大约 5 个小时，但没有任何进展。我的代码旨在将一个大表拆分为几个较小的表并将这些表导出到 excel 中（实际表将超过 1000000 条记录）。代码继续产生错误 3011，说明它在 transferspreadsheet 命令中找不到对象“tmpdata1”。当前代码如下：

注意：DTable 是数据库中的现有表，在前面的编码中定义为公共字符串。

Private Sub Export_over_Multiple_Sheets_Click()

Dim rs As New ADODB.Recordset
Dim cn As New ADODB.Connection
Set cn = CurrentProject.Connection
Dim rowcount As Long
Dim tblcount As Integer
Dim i As Integer
Dim t As TableDef
Dim tblx As String

Dim dbsDatas As DAO.Database
Set dbsDatas = CurrentDb

dbsDatas.TableDefs.Refresh

Dim strWorksheetPathTable As String
Dim xlApp As Object
Dim xlWB As Object

'----Set File Path
strWorksheetPathTable = "O:\Data\Downstream POC\DWN Data Mgmt\Reports\"
strWorksheetPathTable = strWorksheetPathTable & "" & DTable & "\" & DTable & ".xlsb"

Set xlApp = CreateObject("Excel.Application")
Set xlWB = xlApp.Workbooks.Open("" & strWorksheetPathTable & "")

SQL = "SELECT * INTO tmpdata FROM " & DTable & ""
DoCmd.RunSQL SQL
SQL = "ALTER TABLE tmpdata ADD COLUMN id COUNTER"
DoCmd.RunSQL SQL
SQL = "SELECT count(*) as rowcount from " & DTable & ""
rs.Open SQL, cn
rowcount = rs!rowcount
rs.Close
tblcount = rowcount / 50000 + 1
For i = 1 To tblcount
SQL = "SELECT * into tmpdata" & i & " FROM tmpdata" & _
" WHERE id<=50000*" & i
DoCmd.RunSQL SQL
SQL = "DELETE * FROM tmpdata" & _
" WHERE id<=50000*" & i
DoCmd.RunSQL SQL

dbsDatas.TableDefs.Refresh
Set t = Nothing
Set t = dbsDatas.TableDefs("tmpdata" & i & "")

tblx = "tmpdata" & i & ""

DoCmd.TransferSpreadsheet transfertype:=acExport, _
    spreadsheettype:=acSpreadsheetTypeExcel12, _
    TableName:=tblx, FileName:=strWorksheetPathTable, _
    hasfieldnames:=True

Next i

xlWB.Save
xlWB.Close

End Sub

我知道我的编码可能有点混乱，到目前为止，我才自学 vba 几个月。任何帮助将不胜感激。

丹麦人我

Answer 1

想通了。我的编码不再使用的一些旧变量（t、xlApp、xlWB）导致导出出错。从编码中删除这些解决了问题。