Excel VBA错误结束时带有？

Hi friends i am working on export excel rows to Sql Server 2008 Table in that way i am checking the row already exist in table or not

嗨朋友我正在处理导出excel行到Sql Server 2008表那样我正在检查表中是否已经存在的行

my table has

我的桌子有

sap_code depot size entry_date

sap_code depot size entry_date

if table exist that record skip that row and check next row of excel with table

如果表存在该记录跳过该行并使用表检查excel的下一行

here goes my working code

这是我的工作代码

' ===== 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

1 个解决方案

#1

Suggestion: Always indent your code. So even if you look at the code say 6 months down the line, you will know what the code does. Indentation also helps you catch errors which occur as it happened in the code above

建议:始终缩进代码。因此,即使您在6个月后查看代码,您也会知道代码的作用。缩进还可以帮助您捕获上面代码中发生的错误

Here is an example

这是一个例子

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

The same code can be written as

相同的代码可以写成

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

Another suggestion (it is not mandatory though) For a better understanding where does a For loop ends, it is advisable to write Next as say Next i.

另一个建议(虽然它不是强制性的)为了更好地理解For循环的结束位置,建议将Next写为Next i。

So the above code can be further improved to

所以上面的代码可以进一步改进

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

If you implement the above suggestion, you will notice that this section of your code

如果您实施上述建议,您会注意到代码的这一部分

      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**

Solution: Above code can be re-written as

解决方案:上面的代码可以重写为

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