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

如果触发错误的这些字段对您无关紧要，为什么不使用

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方法时，你的注释会停止给定表的整个副本，这是因为你立刻复制了整个记录集。如果循环遍历字段，则错误将是字段本身，然后将恢复到下一个字段而不是下一个字段。我应该有一个代码样本在工作中这样做，如果你有兴趣，明天会发布。

Answer 2

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

跳过导致错误的字段

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

希望这有帮助

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

2 个答案: