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

如果這些觸發錯誤的字段與您無關緊要，為什么不使用

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

希望這可以幫助