Excel VBA错误与结束与出？

嗨，朋友，我正在出口excel行到SQL Server 2008表在这种方式我正在检查行已经存在的表或不

我的桌子有

sap_code库大小entry_date

如果表存在该logging，则跳过该行，并用表格检查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

build议 ：始终缩进你的代码。 所以即使你看了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 

另一个build议（虽然这不是强制性的）为了更好地理解For循环结束的地方，build议Next写下Next 。

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

 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 

如果你实现上面的build议，你会注意到你的代码的这一部分

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

解决scheme ：以上代码可以重写为

 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