XIN NHỜ MỌI NGƯỜI KIỂM TRA GIÚP LỖI CODE ADO

[khanhhero]

Em xin nhờ mọi người xem giúp em xem code em bị lỗi chỗ nào với ạ.
Em cám ơn mọi người.

Sub Nearest_transaction()
'On Error Resume Next
'Application.ScreenUpdating = False

Dim v As String, Cnn As Object, lrs As Object
Dim lr As Long

lr = Sheet1.Range("A1048576").End(xlUp).Row

Set Cnn = CreateObject("ADODB.Connection")
v = Application.Version

With Sheet2
.Range("B7:K10").ClearContents

Cnn.Open ("Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & _
";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0"))
'---------------------------------------------------------------------------------------------------------------
Set lrs = Cnn.Execute("SELECT TOP 3 Contract_No, Date, Seller, Unit, Volume_MT, Unit_price_USD, Contract_value_USD, ETA, Arrived" & _
" FROM [CS_Detail$A2:AD" & lr & "]" & _
" WHERE Material_code = " & .Range("D3").Value & _
" ORDER BY Date DESC ")
.Range("B7").CopyFromRecordset lrs
lrs.Close
End With

Set Cnn = Nothing

'Application.ScreenUpdating = True
End Sub

 

[vanthinh3101]

Em xin nhờ mọi người xem giúp em xem code em bị lỗi chỗ nào với ạ.
Em cám ơn mọi người.

View attachment 213433

Khánh sửa chỗ này xem:

Set lrs = Cnn.Execute("SELECT TOP 3 Contract_No, Date, Seller, Unit, Volume_MT, Unit_price_USD, Contract_value_USD, ETA, Arrived" & _
                                        " FROM [DATA$A2:AD10]" & _
                                        " WHERE Material_code = """ & .Range("D3").Value & """ ORDER BY Date DESC ")

 

[khanhhero]

Khánh sửa chỗ này xem:

Set lrs = Cnn.Execute("SELECT TOP 3 Contract_No, Date, Seller, Unit, Volume_MT, Unit_price_USD, Contract_value_USD, ETA, Arrived" & _
                                        " FROM [DATA$A2:AD10]" & _
                                        " WHERE Material_code = """ & .Range("D3").Value & """ ORDER BY Date DESC ")

Nó báo lỗi connect lose

 

[vanthinh3101]

Nó báo lỗi connect lose

Tớ vẫn chạy ra kết quả được.
Tuy nhiên, nếu câu lệnh trên thì ra kết quả là 3 số Hợp đồng lớn nhất.
Tớ đoán cần lấy Top 3 Hợp đồng có giá trị lớn nhất đúng không?

 

[khanhhero]

Sub Nearest_transaction()
'On Error Resume Next
'Application.ScreenUpdating = False

Dim i, j As Long
Dim v As String
Dim lr As Long

Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strcnn As String
Dim sqlstr As String

lr = Sheet2.Range("A1048576").End(xlUp).Row

v = Application.Version

With Sheet15
.Range("B7:K10").ClearContents

strcnn = "Provider=Microsoft." & IIf(v <> "8.0", "ACE.OLEDB.12.0", "Jet.OLEDB.4.0") & _
";Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel " & IIf(v <> "8.0", "12.0", "8.0")
cnn.Open strcnn
'---------------------------------------------------------------------------------------------------------------
sqlstr = "SELECT TOP 3 Contract_No, Date, Seller, Unit, Volume_MT, Unit_price_USD, Contract_value_USD, ETA, Arrived, Place_of_Delivery" & _
" FROM [CS_Detail$A2:AD" & lr & "]" & _
" WHERE Material_code = 'DK' ORDER BY Date DESC "
sqlstr = Replace(sqlstr, "DK", Sheet15.Range("D3").Value)
rs.Open sqlstr, strcnn
.Range("B7").CopyFromRecordset rs
rs.Close
End With

Set cnn = Nothing

'Application.ScreenUpdating = True
End Sub

Viết chi tiết như thế này thì chạy ok rồi.

Bài đã được tự động gộp: 11/3/19

Tớ vẫn chạy ra kết quả được.
Tuy nhiên, nếu câu lệnh trên thì ra kết quả là 3 số Hợp đồng lớn nhất.
Tớ đoán cần lấy Top 3 Hợp đồng có giá trị lớn nhất đúng không?

Lấy 3 lần nhập hàng gần nhất.