Sub Trich_ADO()
Dim lsSQL As String, cnn As Object, lrs As Object
Set cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With cnn
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ThisWorkbook.Path & "\A.xls" & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
.Open
End With
lsSQL = "SELECT GhiChu, TEN, STT, SoLuong FROM [Data$] " & _
"WHERE GhiChu= 'x'"
lrs.Open lsSQL, cnn, 3, 1
[a:d].Clear
For i = 1 To lrs.Fields.Count
Cells(1, i).Value = lrs.Fields(i - 1).Name
Next
''''''''Bat dau doan 1''''''''''''''''''''''''''''''''''''''''''''''''''
[B] Dim Arr(1 To 100, 1 To 4)[/B]
[B] Dim k As Long[/B]
[B] k = 1[/B]
[B] While lrs.EOF = False[/B]
[B] Arr(k, 1) = lrs.Fields(0)[/B]
[B] Arr(k, 2) = lrs.Fields(1)[/B]
[B] Arr(k, 3) = lrs.Fields(2)[/B]
[B] Arr(k, 4) = lrs.Fields(3)[/B]
[B] k = k + 1[/B]
[B] lrs.MoveNext[/B]
[B] Wend[/B]
[B]'Range("A2").Resize(k, 4) = Arr[/B]
''''''''''Ket Thuc Doan 1
''''''''Bat dau doan 2''''''''''''''''''''''''''''''''''''''''''''''
[B] Range("A2").CopyFromRecordset lrs[/B]
''''''''Ket Thuc Doan 2'''''''''''''''''''''''''''''''''''''''''
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
