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

我使用以下过程将多维记录集导入到电子表格中，也许尝试查看并适应您的情况？这将允许你在同一时间通过检查该字段的内容复制它

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

前处理一个字段，只跳过导致错误的领域，无论是与一个

Resume Next 

无论是下面是该过程：

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方法将停止给定表的整个副本，这是因为您一次复制整个记录集。如果你在字段中循环，那么错误将是字段本身，然后将恢复到下一个字段而不是下一个表。我应该有一个能够在工作中使用的代码样本，如果您有兴趣，我们会在明天发布。