Option Compare Database
Option Explicit
Sub doit()
data_prepare
noobs
Debug.Print "*******************"
data_prepare
var_1
Debug.Print "*******************"
data_prepare
var_2
End Sub
Sub noobs()
Dim rs As Object
Dim rs2 As Object
Dim sqlDel As String
Dim objConnectionEx, objConnectionSer
Dim t#, strsql$, i&
t = Timer
Set objConnectionEx = CreateObject("ADODB.Connection")
Set objConnectionSer = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs2 = CreateObject("ADODB.Recordset")
Set objConnectionEx = CurrentProject.AccessConnection
strsql = "select * from orderdetails"
rs.Open strsql, objConnectionEx, 3, 3 ' открываем рекордсет excel
If rs.BOF And rs.EOF Then
MsgBox "Файл пуст"
Else
objConnectionSer.Open "Provider=SQLOLEDB;Data Source=RadioX\FData;Database=northwind;User ID=sa;Password=0" 'строка подключения к skid
rs.MoveLast: rs.MoveFirst 'прогон рекордсета на последнюю запись и назад к первой для правильного подсчета количества записей
rs2.Open "[dbo].[Order Details]", objConnectionSer, 3, 3 'открываем рекордсет таблицы Skid
For i = 1 To rs.RecordCount 'цикл по записям рекордсета из excel
If DCount("*", "[dbo_Order Details]", "[OrderID]=" & rs.Fields(0) & " and [ProductID]=" & rs.Fields(1)) = 0 Then
rs2.AddNew
rs2.Fields("OrderID") = rs.Fields("OrderID") '0
rs2.Fields("ProductID") = rs.Fields("ProductID") '1
rs2.Fields("UnitPrice") = rs.Fields("UnitPrice") '2
rs2.Fields("Quantity") = rs.Fields("Quantity") '3
rs2.Fields("Discount") = rs.Fields("Discount") '3
rs2.Update
End If
If i < rs.RecordCount Then rs.MoveNext 'если переменная цикла не добралась до конца то двигаем рекордсет eXcel на следующую запись
Next i
End If
Debug.Print "var Noobs Итого - " & Timer - t
rs2.Close
rs.Close
Set rs = Nothing
Set rs2 = Nothing
End Sub
Sub var_1()
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim r1 As ADODB.Recordset
Dim r2 As ADODB.Recordset
Dim r3 As ADODB.Recordset
Dim s$, t1#, t2#, i&
t1 = Timer
Set r1 = New ADODB.Recordset
r1.Open "select * from orderdetails", CurrentProject.AccessConnection, adOpenForwardOnly, adLockReadOnly
Set con = New ADODB.Connection
s = "Provider=SQLOLEDB.1;Data Source=RadioX\FData;Database=northwind;User ID=sa;Password=0"
con.CursorLocation = adUseClient
con.Open s
s = "select 1 from [order details] where orderid=? and productid=?"
Set cmd = New ADODB.Command
cmd.CommandType = adCmdText
cmd.CommandText = s
cmd.ActiveConnection = con
Set r2 = New ADODB.Recordset
r2.Open "select * from [order details] where 1=0 ", con, adOpenStatic, adLockBatchOptimistic
Set r2.ActiveConnection = Nothing
r2.Fields("orderid").Properties("Optimize") = True
r2.Fields("productid").Properties("Optimize") = True
Set r3 = New ADODB.Recordset
Do Until r1.EOF
cmd.Parameters(0) = r1!OrderID
cmd.Parameters(1) = r1!productid
r3.Open cmd, , adOpenStatic, adLockReadOnly
If r3.EOF Then
r2.AddNew
r2!OrderID = r1!OrderID
r2!productid = r1!productid
r2!UnitPrice = r1!UnitPrice
r2!Quantity = r1!Quantity
r2!Discount = r1!Discount
End If
r3.Close
r1.MoveNext
Loop
Debug.Print "Var 1 Поиск - ", Timer - t1
t2 = Timer
Set r2.ActiveConnection = con
r2.UpdateBatch
On Error Resume Next
r3.Close: Set r3 = Nothing
r1.Close: Set r1 = Nothing
r2.Close: Set r2 = Nothing
Set cmd = Nothing
con.Close: Set cmd = Nothing
Debug.Print "Var 1 Вставка - ", Timer - t2
Debug.Print "Var 1 Итого - ", Timer - t1
End Sub
Sub var_2()
Dim con As ADODB.Connection
Dim r1 As ADODB.Recordset
Dim r2 As ADODB.Recordset
Dim r3 As ADODB.Recordset
Dim s$, t1#, t2#, i&
t1 = Timer
Set r1 = New ADODB.Recordset
r1.Open "select * from orderdetails", CurrentProject.AccessConnection, adOpenForwardOnly, adLockReadOnly
Set con = New ADODB.Connection
s = "Provider=SQLOLEDB.1;Data Source=RadioX\FData;Database=northwind;User ID=sa;Password=0"
con.CursorLocation = adUseClient
con.Open s
s = "select * from [order details] where 1 = 0"
Set r2 = New ADODB.Recordset
r2.Open s, con, adOpenStatic, adLockBatchOptimistic
Set r2.ActiveConnection = Nothing
s = "select * from [order details]"
Set r3 = New ADODB.Recordset
r3.Open s, con, adOpenStatic, adLockBatchOptimistic
Set r3.ActiveConnection = Nothing
r3.Fields("orderid").Properties("Optimize") = True
r3.Fields("productid").Properties("Optimize") = True
Do Until r1.EOF
r3.Filter = ""
r3.Filter = "orderid=" & r1!OrderID & " and productid=" & r1!productid
If r3.EOF Then
r2.AddNew
r2!OrderID = r1!OrderID
r2!productid = r1!productid
r2!UnitPrice = r1!UnitPrice
r2!Quantity = r1!Quantity
r2!Discount = r1!Discount
End If
r1.MoveNext
Loop
Debug.Print "var 2 Поиск - ", Timer - t1
t2 = Timer
Set r2.ActiveConnection = con
r2.UpdateBatch
On Error Resume Next
r1.Close: Set r1 = Nothing
r2.Close: Set r2 = Nothing
r3.Close: Set r3 = Nothing
con.Close: Set con = Nothing
Debug.Print "var 2 Вставка - ", Timer - t2
Debug.Print "var 2 Итого - ", Timer - t1
End Sub
Sub data_prepare()
Dim con As ADODB.Connection
Dim cmd As ADODB.Command
Dim r As ADODB.Recordset
Dim s$
Set con = New ADODB.Connection
s = "Provider=SQLOLEDB.1;Data Source=RadioX\FData;Database=northwind;User ID=sa;Password=0"
con.CursorLocation = adUseClient
con.Open s
s = "delete from [order details] where orderid=? and productid=?"
Set cmd = New ADODB.Command
cmd.CommandType = adCmdText
cmd.CommandText = s
cmd.ActiveConnection = con
Set r = New ADODB.Recordset
r.Open "select * from [order details] ", con, adOpenStatic, adLockBatchOptimistic
Set r.ActiveConnection = Nothing
Do Until r.EOF
If r.AbsolutePosition / 2 = r.AbsolutePosition \ 2 Then
With cmd
.Parameters(0) = r!OrderID
.Parameters(1) = r!productid
.Execute
End With
End If
r.MoveNext
Loop
On Error Resume Next
r.Close: Set r = Nothing
Set cmd = Nothing
con.Close: Set cmd = Nothing
End Sub
|