Excel自动化错误导入DB到工作表

我有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

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

 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方法时，请重新提供您的评论将停止给定表的整个副本，这是因为您一次复制整个logging集。 如果你通过字段循环错误将是领域本身，然后将恢复到下一个领域，而不是下一个表。 我应该有一个在工作的代码样本，明天会发布，如果你有兴趣。