Excel 自动化错误将数据库导入工作表

Question

我有一个包含 192 个工作表的工作簿，这些工作表对应于我们的 mssql 数据库中的 192 个表。如果我在数据连接向导中设置了一个给定的表，所有数据都会正确地转储到工作表中。但是，当我在下面运行我的代码时，我得到：

运行时错误“214767259 (80004005)”自动化错误未指定错误

大约一半的表格填充得很好。我注意到，一旦到达具有大量数据（rtf 文本）的字段，我就会收到错误消息。具有该文本的字段对我来说并不重要，所以如果 excel 可以将这些留空并继续，我会很高兴。该大字段位于不同的列（有时是多个列）中，具体取决于每个表，因此必须遍历所有 192 个表以清除单个列而不导入是非常耗时的。

为什么我在vba中运行时出现这个错误，但是数据连接向导没有问题？

Sub GetData()

Dim cnDump As ADODB.Connection
Set cnDump = New ADODB.Connection

' Provide the connection string.
Dim strConn As String

'Use the SQL Server OLE DB Provider.
strConn = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=XXXX;Data Source=XXXX\XXXX;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=XXXX;Use Encryption for Data=False;Tag with column collation when possible=False;"

'Now open the connection.
cnDump.Open strConn


' GET DATA
Dim ws As Worksheet
Dim tbl_name As String

Dim rsDump As ADODB.Recordset
Set rsDump = New ADODB.Recordset

For Each ws In Worksheets

tbl_name = ws.Name
ws.Rows.ClearContents

With rsDump

    .ActiveConnection = cnDump
    .Open "SELECT * FROM " & tbl_name

    For i = 1 To .Fields.Count
     ws.Cells(1, i) = .Fields(i - 1).Name
    Next i


    ws.Range("A2").CopyFromRecordset rsDump

End With


ws.Rows(1).Font.Bold = True


Next ws

cnDump.Close
Set rsDump = Nothing
Set cnDump = Nothing



End Sub

Answer 1

我使用以下过程将多维记录集导入电子表格，也许尝试看看并适应您的情况？这将允许您一次处理一个字段，并且只跳过导致错误的字段，或者使用

Resume Next

在复制之前检查字段的内容

If Len(Rs.Fields(a,b))<500 Then MySheet.MyCell.Value=Rs.Fields(a,b)

程序如下：

j = -1

Dim MyArray As Variant
ReDim MyArray(RS.RecordCount, RS.Fields.Count)

If RS.RecordCount = 0 Then

    ReDim MyArray(0, 0)
    MyArray(0, 0) = "No Data"

Else

    Do While Not (RS.EOF)

    j = j + 1

        For i = 0 To RS.Fields.Count - 1

            MyArray(j, i) = Trim(RS.Fields(i))

        Next i

        RS.MoveNext

    Loop

End If

希望对你有帮助

Answer 2

如果这些触发错误的字段对您来说并不重要，为什么不使用

On Error Resume Next

方法？

或者如果你想避免另一个错误在不应该被忽略的时候被忽略，也许可以通过添加更精确地处理错误：

Sub GetData()

On Error GoTo GetData_Error

[your code here]

On Error GoTo 0
Exit Sub

GetData_Error:

If Err.Number=214767259 Then''assuming this is the correct code, you might need to track it     before using Debug.Print Err.Number

Err.Clear
Resume Next

End If

End Sub

编辑：

当您提到 Resume Next 方法时，您的评论将停止给定表的整个副本，这是因为您一次复制整个记录集。如果您遍历字段，则错误将出现在字段本身，然后将恢复到下一个字段而不是下一个表。我应该有一个在工作中执行此操作的代码示例，如果您有兴趣，将在明天发布。