1
喜的朋友我在出口工作出色行到SQL Server 2008表 以这种方式我已经检查的行存在于表或不Excel VBA错误以out out结束？
我的表有
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
将'End With'这在上面突出显示的“Next”之前突出显示。现在尝试一下。 –
为什么我总是在这里downvoted @ Siddharth谢谢你的帮助 – Devendar