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

时间:2014-10-13 08:00:20

标签: excel vba transfer

我一直试图让这个编码工作大约5个小时,现在没有进展。我的代码旨在将一个大表拆分成几个较小的表并将它们导出到excel中(实际表将超过1000000条记录)。代码继续产生错误3011,说明它无法找到对象' tmpdata1'在transferspreadsheet命令中。目前的代码如下:

注意: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几个月。任何帮助将不胜感激。

Dane I

1 个答案:

答案 0 :(得分:0)

想出来。我的编码(t,xlApp,xlWB)不再使用的一些旧变量导致出口错误。从编码中删除这些修复了问题。

相关问题