Excel VBA錯誤結束時帶有？

Question

嗨朋友我正在處理導出excel行到Sql Server 2008表那樣我檢查表中已存在的行或不

我的桌子有

sap_code depot size entry_date

如果表存在該記錄跳過該行並使用表檢查excel的下一行

這是我的工作代碼

' ===== Export Using ADO =====

Function ExportRangeToSQL(ByVal sourceRange As Range, _
    ByVal conString As String, ByVal table As String) As Integer

    On Error Resume Next

    ' Object type and CreateObject function are used instead of ADODB.Connection,
    ' ADODB.Command for late binding without reference to
    ' Microsoft ActiveX Data Objects 2.x Library

    ' ADO API Reference
    ' http://msdn.microsoft.com/en-us/library/ms678086(v=VS.85).aspx

    ' Dim con As ADODB.Connection
    Dim con As Object
    Set con = CreateObject("ADODB.Connection")

    con.ConnectionString = conString
    con.Open

    ' Dim cmd As ADODB.Command
    Dim cmd As Object
    Set cmd = CreateObject("ADODB.Command")

    cmd.CommandType = 1             ' adCmdText

       ' Dim rst As ADODB.Recordset
    Dim rst As Object
    Set rst = CreateObject("ADODB.Recordset")

    With rst
        Set .ActiveConnection = con
        .Source = "SELECT * FROM " & table
        .CursorLocation = 3         ' adUseClient
        .LockType = 4               ' adLockBatchOptimistic
         .CursorType = 1             ' adOpenKeyset
        .CursorType = 0             ' adOpenForwardOnly
        .Open

        ' Do While Not .EOF
        '    .MoveNext
        ' Loop

        ' Column Mappings

        Dim tableFields(100) As Integer
        Dim rangeFields(100) As Integer

        Dim exportFieldsCount As Integer
        exportFieldsCount = 0

        Dim col As Integer
        Dim index As Integer

        For col = 1 To .Fields.Count - 1
            index = Application.Match(.Fields(col).Name, sourceRange.Rows(1), 0)
            If index > 0 Then
                exportFieldsCount = exportFieldsCount + 1
                tableFields(exportFieldsCount) = col
                rangeFields(exportFieldsCount) = index
            End If
        Next

        If exportFieldsCount = 0 Then
            ExportRangeToSQL = 1
            Exit Function
        End If

        ' Fast read of Excel range values to an array
        ' for further fast work with the array

        Dim arr As Variant
        arr = sourceRange.Value

        ' Column names should be equal
        ' For col = 1 To exportFieldsCount
        '     Debug.Print .Fields(tableFields(col)).Name & " = " & arr(1, rangeFields(col))
        ' Next

        ' The range data transfer to the Recordset

        Dim row As Long
        Dim rowCount As Long
        rowCount = UBound(arr, 1)


        Dim val As Variant

        For row = 2 To rowCount

        ' Testing the Ledger data to insert
        Dim qu As String
        Dim br, de, si, da As String
       br = arr(row, rangeFields(1))  ' sap_code from excel
       de = arr(row, rangeFields(2)) ' depot from excel
       si = arr(row, rangeFields(3)) ' size from excel
       da = arr(row, rangeFields(5)) ' entry_date from excel

     Set con = CreateObject("ADODB.Connection")

    con.ConnectionString = conString
    con.Open


      Dim rstTest As ADODB.Recordset
      Set rstTest = New ADODB.Recordset
      With rstTest
       .CursorLocation = adUseClient
       .Open "select TOP 1 sap_code, depot, size, entry_date from openstock where " + "sap_code='" + br + "' and depot='" + de + "' and size='" + si + "' and entry_date='" + da + "' ORDER BY id DESC", con, adOpenStatic, adLockBatchOptimistic, adCmdText
  MsgBox "SAP_CODE" & br & "Depot" & de & "Size" & si & "entry_date" & da & "Duplicate Entry Not Entered into Database"
         If br = rstTest.Fields("sap_code").Value And _
            de = rstTest.Fields("depot").Value And _
            si = rstTest.Fields("size").Value And _
            da = rstTest.Fields("entry_date").Value Then


            Else

      End With  **NOte:  Error showing here as End With with out With**
            .AddNew
            For col = 1 To exportFieldsCount
                val = arr(row, rangeFields(col))
                If IsEmpty(val) Then
                Else
                    .Fields(tableFields(col)) = val
                End If
            Next
            End If
        Next   **NOte: Problem showing here as Next with out FOR**

        .UpdateBatch

    End With

    rst.Close
    Set rst = Nothing


    con.Close
    Set con = Nothing

    ExportRangeToSQL = 0

End Function

Answer 1

建議 ：始終縮進代碼。 因此，即使你看了6個月后的代碼，你也會知道代碼的作用。 縮進還可以幫助您捕獲上面代碼中發生的錯誤

這是一個例子

Sub Sample()
    For i = 1 to 5
    For j = 1 to 10
    For k = 1 to 7
    If a = 10 then
    End If
    Next
    Next
    Next
End Sub

相同的代碼可以寫成

Sub Sample()
    For i = 1 to 5
        For j = 1 to 10
            For k = 1 to 7
                If a = 10 then

                End If
            Next
        Next
    Next
End Sub

另一個建議（雖然不是強制性的）為了更好地理解For循環的結束，建議將Next寫為Next i 。

所以上面的代碼可以進一步改進

Sub Sample()
    For i = 1 to 5
        For j = 1 to 10
            For k = 1 to 7
                If a = 10 then

                End If
            Next k
        Next j
    Next i
End Sub

如果您實施上述建議，您會注意到代碼的這一部分

      With rstTest
       .CursorLocation = adUseClient
       .Open "select TOP 1 sap_code, depot, size, entry_date from openstock where " + "sap_code='" + br + "' and depot='" + de + "' and size='" + si + "' and entry_date='" + da + "' ORDER BY id DESC", con, adOpenStatic, adLockBatchOptimistic, adCmdText
  MsgBox "SAP_CODE" & br & "Depot" & de & "Size" & si & "entry_date" & da & "Duplicate Entry Not Entered into Database"
         If br = rstTest.Fields("sap_code").Value And _
            de = rstTest.Fields("depot").Value And _
            si = rstTest.Fields("size").Value And _
            da = rstTest.Fields("entry_date").Value Then


            Else

      End With  **NOte:  Error showing here as End With with out With**
            .AddNew
            For col = 1 To exportFieldsCount
                val = arr(row, rangeFields(col))
                If IsEmpty(val) Then
                Else
                    .Fields(tableFields(col)) = val
                End If
            Next
            End If
        Next   **NOte: Problem showing here as Next with out FOR**

解決方案 ：上面的代碼可以重寫為

For row = 2 To rowCount
    '
    '
    '
    With rstTest
        .CursorLocation = adUseClient
        .Open "select TOP 1 sap_code, depot, size, entry_date from openstock where " + _
        "sap_code='" + br + "' and depot='" + de + "' and size='" + si + _
        "' and entry_date='" + da + "' ORDER BY id DESC", con, adOpenStatic, _
        adLockBatchOptimistic, adCmdText

        MsgBox "SAP_CODE" & br & "Depot" & de & "Size" & si & "entry_date" & da & _
        "Duplicate Entry Not Entered into Database"

        If br = rstTest.Fields("sap_code").Value And _
                de = rstTest.Fields("depot").Value And _
                si = rstTest.Fields("size").Value And _
                da = rstTest.Fields("entry_date").Value Then
        Else
           '~~> Removed End With from here
           'End With  **NOte:  Error showing here as End With with out With**
            .AddNew
            For col = 1 To exportFieldsCount
                val = arr(row, rangeFields(col))
                If IsEmpty(val) Then
                Else
                    .Fields(tableFields(col)) = val
                End If
            Next col
        End If
    End With '<~~ Pasted it here
Next row