sql-server - Excel VBA 错误 End with with out with？

Question

嗨 friend 们，我正在将 excel 行导出到 Sql Server 2008 表
这样我正在检查表中是否已经存在该行

我的 table 有

sap_code
仓库
尺寸
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