Excel VBA error End with with out with?

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

my table has

sap_code depot size entry_date

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

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

Answers


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

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.

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

Need Your Help

Not able to display the content on the grid dynamically from database

json extjs

I want to display load the form data from database and display that data into grid. But while doing that task I am facing one problem i.e., I am unable to get the JSON response into grid only empty...