Bài tập về ADO căn bản.

Liên hệ QC

Hai Lúa Miền Tây

❆❆❆❆❆❆❆❆
Thành viên BQT
Administrator
Tham gia
18/3/08
Bài viết
8,281
Được thích
15,780
Giới tính
Nam
Nghề nghiệp
Làm ruộng.
Bài 1:
Nhằm mục đích luyện tập và nâng cao kiến thức về ADO tôi xin mở topic này. Topic này chỉ dành cho những người mới học, bắt đầu học ADO như tôi tham gia.

Tôi có 2 Workbooks (A.xls và B.xls chung 1 folder): Wb A.xls có 1 sheet là sheet data dùng để chứa dữ liệu, wb B.xls là wb rỗng, trong đó có sheet1.

Xin hỏi là dùng ADO từ WB A.xls để copy toàn bộ dữ liệu của sheet data sang WB B.xls với sheet chứa dữ liệu là data
 

File đính kèm

  • CopyDuLieu.rar
    2.5 KB · Đọc: 863
Lần chỉnh sửa cuối:
Em chưa biết về ADO, có lẻ người biết thì không tham gia, người mới biết thì ít, người chưa biết thì nhiều. Vạn sự khởi đầu, vui lòng anh cho kết quả để người chưa biết bắt đầu học tập. Xin anh viết code kèm lời chú thích để dể hiểu hơn
Cảm ơn Anh.
P/s: Anh có thể đổi tiêu đề thành "Bài tập ADO" chẳng hạn được không?
 
Mình cũng vọc phá ADO vài lần. Loay hoay học được chút ít nhưng không ứng dụng thường rồi lại quên mất tiêu. Thế là nản lòng bỏ qua luôn. VBA đơn giản hơn là nếu quên cú pháp thì còn record macro để xem lại, còn ADO thì chẳng biết dựa vào chỗ nào hết.
 
Em chưa biết về ADO, có lẻ người biết thì không tham gia, người mới biết thì ít, người chưa biết thì nhiều. Vạn sự khởi đầu, vui lòng anh cho kết quả để người chưa biết bắt đầu học tập. Xin anh viết code kèm lời chú thích để dể hiểu hơn
Cảm ơn Anh.
P/s: Anh có thể đổi tiêu đề thành "Bài tập ADO" chẳng hạn được không?

Thật ra bài tập này tương tự như bài ở link http://www.giaiphapexcel.com/forum/...xcel-sang-file-Excel-khác&p=461164#post461164
Vậy anh làm thử nhé.
 
Thật ra bài tập này tương tự như bài ở link http://www.giaiphapexcel.com/forum/...xcel-sang-file-Excel-khác&p=461164#post461164
Vậy anh làm thử nhé.
Em thấy giống hoàn toàn, chỉ thay tên đổi họ mà vẫn không được
[GPECODE=vb]Sub CopyDL()
Dim cnn As Object, lsSQL As String, 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.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
.Open
End With
lsSQL = "INSERT INTO [Data$] IN '" & ThisWorkbook.Path & _
"\B.xls ' 'Excel 8.0;' SELECT f1,f2,f3,f4 FROM [Data$A1:D15]"
lrs.Open lsSQL, cnn, 3, 1
Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub


[/GPECODE]

LoiADO.JPG

Báo lỗi dòng thứ 12. Em biết chưa hiểu hết cấu trúc lệnh thôi
Cụ thể:
1. Với câu lệnh trên là chèn dòng, vậy copy sang là lệnh nào
2. Khi dán A1:Ạ1 sheet "Data" vào File B.xls ở vị trí nào?
Anh gợi ý tiếp em với nhé
Cảm ơn Anh
--------
Xin lỗi sửa chưa hết ở dòng 11, nhưng sửa xong báo lỗi:

LoiADO1.JPG
 
Chỉnh sửa lần cuối bởi điều hành viên:
Em thấy giống hoàn toàn, chỉ thay tên đổi họ mà vẫn không được
[GPECODE=vb]Sub CopyDL()
Dim cnn As Object, lsSQL As String, 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.FullName & _
";Extended Properties=""Excel 8.0;HDR=No;"";"
.Open
End With
lsSQL = "INSERT INTO [Data$] IN '" & ThisWorkbook.Path & _
"\B.xls ' 'Excel 8.0;' SELECT f1,f2,f3,f4 FROM [Data$A1:D15]"
lrs.Open lsSQL, cnn, 3, 1
Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub


[/GPECODE]

View attachment 94291

Báo lỗi dòng thứ 12. Em biết chưa hiểu hết cấu trúc lệnh thôi
Cụ thể:
1. Với câu lệnh trên là chèn dòng, vậy copy sang là lệnh nào
2. Khi dán A1:Ạ1 sheet "Data" vào File B.xls ở vị trí nào?
Anh gợi ý tiếp em với nhé
Cảm ơn Anh
--------
Xin lỗi sửa chưa hết ở dòng 11, nhưng sửa xong báo lỗi:

View attachment 94296

Anh lưu ý là wb B.xls là wb rỗng, trong đó có sheet1. Code trên là chèn thêm dòng, và file B không có sheet data, anh cho chèn thêm dòng vào sheet data nó báo lỗi là đúng rồi. Bài tập là copy sheet thành sheet data, cách anh làm là chèn thêm dòng, thôi thì là làm chèn thêm dòng trước rồi copy thành sheet data. Anh thử sửa lại như sau:

  1. Đổi sheet Data thành Sheet1
  2. Vào file B.xls gõ vào tiêu đề cột của A1 là F1, B1 là F2, C1 là F3, D1 là F4 vì ở code trên anh chọn HDR=No và câu lệnh truy vấn đến tên cột để chèn phải có tên tương ứng với nhau.
Anh thử nhé
 
Anh lưu ý là wb B.xls là wb rỗng, trong đó có sheet1. Code trên là chèn thêm dòng, và file B không có sheet data, anh cho chèn thêm dòng vào sheet data nó báo lỗi là đúng rồi. Bài tập là copy sheet thành sheet data, cách anh làm là chèn thêm dòng, thôi thì là làm chèn thêm dòng trước rồi copy thành sheet data. Anh thử sửa lại như sau:

  1. Đổi sheet Data thành Sheet1
  2. Vào file B.xls gõ vào tiêu đề cột của A1 là F1, B1 là F2, C1 là F3, D1 là F4 vì ở code trên anh chọn HDR=No và câu lệnh truy vấn đến tên cột để chèn phải có tên tương ứng với nhau.
Anh thử nhé
- Trường hợp chèn dòng vậy nhưng kết quả không giống như file A.xls
Anh xem giúp em còn sai gì em với nhé
- Trường hợp copy sheet code như thế nào Anh?
Em cảm ơn.
 

File đính kèm

  • CopyDuLieu.rar
    14.5 KB · Đọc: 213
- Chèn thêm dữ liệu: Anh thử so sánh code sau với code của anh nhé

[GPECODE=sql]Sub CopyDL()
Dim cnn As Object, lsSQL As String, 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.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
.Open
End With
lsSQL = "INSERT INTO [Sheet1$] IN '" & ThisWorkbook.Path & _
"\B.xls ' 'Excel 8.0;' SELECT Stt, TEN, SOLUONG, GHICHU FROM [Data$]"
lrs.Open lsSQL, cnn, 3, 1
Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub

[/GPECODE]

- Code copy sang sheet data, chỉ chạy code được 1 lần.

[GPECODE=sql]Sub CopyDATA()
On Error GoTo Handle
Dim cnn As Object, lsSQL As String, 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.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
.Open
End With
lsSQL = "SELECT Stt, TEN, SOLUONG, GHICHU INTO [Excel 8.0;Database=" & ThisWorkbook.Path & _
"\B.xls].[DATA] FROM [Data$]"
lrs.Open lsSQL, cnn, 3, 1
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
Exit Sub
Handle:
MsgBox Err.Description
Set lrs = Nothing
cnn.Close: Set cnn = Nothing

End Sub


[/GPECODE]
 
- Chèn thêm dữ liệu: Anh thử so sánh code sau với code của anh nhé

[GPECODE=sql]Sub CopyDL()
Dim cnn As Object, lsSQL As String, 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.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
.Open
End With
lsSQL = "INSERT INTO [Sheet1$] IN '" & ThisWorkbook.Path & _
"\B.xls ' 'Excel 8.0;' SELECT Stt, TEN, SOLUONG, GHICHU FROM [Data$]"
lrs.Open lsSQL, cnn, 3, 1
Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub

[/GPECODE]

- Code copy sang sheet data, chỉ chạy code được 1 lần.

[GPECODE=sql]Sub CopyDATA()
On Error GoTo Handle
Dim cnn As Object, lsSQL As String, 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.FullName & _
";Extended Properties=""Excel 8.0;HDR=Yes;"";"
.Open
End With
lsSQL = "SELECT Stt, TEN, SOLUONG, GHICHU INTO [Excel 8.0;Database=" & ThisWorkbook.Path & _
"\B.xls].[DATA] FROM [Data$]"
lrs.Open lsSQL, cnn, 3, 1
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
Exit Sub
Handle:
MsgBox Err.Description
Set lrs = Nothing
cnn.Close: Set cnn = Nothing

End Sub
[/GPECODE]
Cảm ơn Anh rất nhiều, em đã hiểu được cơ bản 2 nội dung trên
Anh cho em hỏi thêm: Câu lệnh
[GPECODE=vb]lrs.Open lsSQL, cnn, 3, 1[/GPECODE]
Nếu sửa thành [GPECODE=vb]lrs.Open lsSQL, cnn[/GPECODE]
Kết quả vẫn chạy. Vậy 2 thông số đó là gì vậy?
 
Cảm ơn Anh rất nhiều, em đã hiểu được cơ bản 2 nội dung trên
Anh cho em hỏi thêm: Câu lệnh
[GPECODE=vb]lrs.Open lsSQL, cnn, 3, 1[/GPECODE]
Nếu sửa thành [GPECODE=vb]lrs.Open lsSQL, cnn[/GPECODE]
Kết quả vẫn chạy. Vậy 2 thông số đó là gì vậy?

Nếu có thời gian anh vào trang sau: http://www.giaiphapexcel.com/forum/showthread.php?65492-Kết-nối-Thao-tác-giữa-Excel-và-Access
Hoặc tìm ebook của anh Duyệt về ngâm cứu nhé.
 
Mình cũng Loay hoay học được chút ít nhưng không ứng dụng thường rồi lại quên mất tiêu. Thế là nản bỏ qua luôn. VBA đơn giản hơn là nếu quên cú pháp thì còn record macro để xem lại, còn ADO thì chẳng biết dựa vào chỗ nào hết.

Các câu lệnh này sẽ na ná trong MS Access (ngăn query hay sao í)
 
Các câu lệnh này sẽ na ná trong MS Access (ngăn query hay sao í)

Chính xác là như thế, nếu chưa quen với những câu lệnh truy vấn thì ta chuyển vào access rồi vào query test thử, nếu kết quả ok thì copy kết quả của câu lệnh truy vấn ở access query đó vào excel là được. Nó rất đơn giản.
 
Nếu có thời gian anh vào trang sau: http://www.giaiphapexcel.com/forum/showthread.php?65492-Kết-nối-Thao-tác-giữa-Excel-và-Access
Hoặc tìm ebook của anh Duyệt về ngâm cứu nhé.
Có nghiên cứu nhưng cũng khó hiểu thật (Anh thông cảm kiến thức em có hạn)
có lẽ một số bài tập mới làm cho em dễ hiểu hơn. Anh giúp em nhé
Trường hợp bài tập ở bài 1 của Anh nhưng làm ngược lại là từ file B.xls lấy dự liệu ở file A.xls thì làm sao em loay hoay mãi không được, xin được giúp đỡ
Em cảm ơn.
 
Có nghiên cứu nhưng cũng khó hiểu thật (Anh thông cảm kiến thức em có hạn)
có lẽ một số bài tập mới làm cho em dễ hiểu hơn. Anh giúp em nhé
Trường hợp bài tập ở bài 1 của Anh nhưng làm ngược lại là từ file B.xls lấy dự liệu ở file A.xls thì làm sao em loay hoay mãi không được, xin được giúp đỡ
Em cảm ơn.

Mở file B, anh chép đoạn code sau vào và sau đó chạy code nhé:

[GPECODE=sql]Sub LayDL_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
'lay het du lieu co trong sheet Data o file A.xls
lsSQL = "SELECT * " & _
"FROM [Data$] "
lrs.Open lsSQL, cnn, 3, 1
With Sheet1
.[A2:D1000].ClearContents
.[A2].CopyFromRecordset lrs
End With
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing

End Sub[/GPECODE]
 
Mở file B, anh chép đoạn code sau vào và sau đó chạy code nhé:

[GPECODE=sql]Sub LayDL_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
'lay het du lieu co trong sheet Data o file A.xls
lsSQL = "SELECT * " & _
"FROM [Data$] "
lrs.Open lsSQL, cnn, 3, 1
With Sheet1
.[A2:D1000].ClearContents
.[A2].CopyFromRecordset lrs
End With
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing

End Sub[/GPECODE]
Trường hợp em không muốn copy vào bảng tính trực tiếp và chuyển vùng dữ liệu ở file A.xls vào 1 mãng Arr() sau đó mới truyền dữ liệu mãng đó xuống bảng tính thì code thay đổi thế nào hở Anh?
 
Trường hợp em không muốn copy vào bảng tính trực tiếp và chuyển vùng dữ liệu ở file A.xls vào 1 mãng Arr() sau đó mới truyền dữ liệu mãng đó xuống bảng tính thì code thay đổi thế nào hở Anh?

viehoai thử dùng cái này xem:

[GPECODE=vb]
Sub LayDL_ADO()
Dim lsSQL As String, cnn As Object, lrs As Object

Dim Arr As Variant

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 * FROM [Data$] "
lrs.Open lsSQL, cnn, 3, 1

Arr = lrs.GetRows

lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
[/GPECODE]

LƯU Ý: Mảng Arr này là một mảng "ngược" nhé! muốn đổi lại mảng 2 chiều thì phải dùng vòng lặp thôi.

----------------------------------------------------------

Phần thêm: Chuyển mảng từ mảng "ngược"

[GPECODE=vb]

Sub LayDL_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 * FROM [Data$] "
lrs.Open lsSQL, cnn, 3, 1

Dim Arr As Variant, ExcelArr As Variant, i As Long, _
c As Long, h As Long, r As Long, v As Long

Arr = lrs.GetRows

v = UBound(Arr, 1) + 1
h = UBound(Arr, 2) + 1

ReDim ExcelArr(1 To h, 1 To v): r = 0
For i = 1 To h
r = r + 1
For c = 1 To v
ExcelArr(r, c) = Arr(c - 1, i - 1)
Next
Next

Sheet2.Range("A1").Resize(h, v).Value = ExcelArr

lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing
End Sub
[/GPECODE]
 
Lần chỉnh sửa cuối:
Làm hẳn 1 hàm chuyển đổi luôn

Mã:
Function TransArr(sArr As Variant) As Variant
    Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
    tmpX = UBound(sArr, 2):    tmpY = UBound(sArr, 1)
    ReDim tmpArr(tmpX, tmpY)
    For cllX = 0 To tmpX
        For cllY = 0 To tmpY
            tmpArr(cllX, cllY) = sArr(cllY, cllX)
        Next cllY
    Next cllX
    TransArr = tmpArr

End Function

Chạy thử code sau:

[GPECODE=sql]Sub LayDL_ADO()
Dim lsSQL As String, cnn As Object, lrs As Object, rstArr As Variant, lFields As Long, lRecrds As Long
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 * " & _
"FROM [Data$] "
lrs.Open lsSQL, cnn, 3, 1
lFields = lrs.Fields.Count
With Sheet1
.[A2:D1000].ClearContents
rstArr = lrs.GetRows
lRecrds = UBound(rstArr, 2) + 1
.Range("A2").Resize(lRecrds, lFields).Value = TransArr(rstArr)
End With
Erase rstArr
lrs.Close: Set lrs = Nothing
cnn.Close: Set cnn = Nothing

End Sub

[/GPECODE]
 
Em làm thử một hàm nhưng xuất dữ liệu không đủ ở file A.xls
Nhờ các anh chị xem giúp
[GPECODE=vb]Function GetData(FileFullName, ShName As String)Dim lsSQL As String, Cnn As Object, lrs As Object, rstArr As Variant
Set Cnn = CreateObject("ADODB.Connection")
Set lrs = CreateObject("ADODB.Recordset")
With Cnn
If Val(Application.Version) < 12 Then
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 8.0;HDR=Yes"";"
Else
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileFullName & ";Extended Properties=""Excel 12.0;HDR=Yes"";"
End If
.Open
End With
lsSQL = "SELECT * " & "FROM [" & ShName & "$] "
lrs.Open lsSQL, Cnn, 3, 1
rstArr = lrs.GetRows
GetData = TransArr(rstArr)
End Function[/GPECODE]
[GPECODE=vb]Sub Test()
Dim Arr()
Arr = GetData(ThisWorkbook.Path & "\A.xls", "Data")
Range("A2").Resize(UBound(Arr), UBound(Arr, 2)).Value = Arr
End Sub
[/GPECODE]
[GPECODE=vb]Function TransArr(sArr As Variant) As Variant Dim cllX As Long, cllY As Long, tmpX As Long, tmpY As Long, tmpArr As Variant
tmpX = UBound(sArr, 2): tmpY = UBound(sArr, 1)
ReDim tmpArr(tmpX, tmpY)
For cllX = 0 To tmpX
For cllY = 0 To tmpY
tmpArr(cllX, cllY) = sArr(cllY, cllX)
Next cllY
Next cllX
TransArr = tmpArr
End Function[/GPECODE]
Xin cảm ơn các anh chị
 
Anh thử chỉnh lại như sau:

[GPECODE=vb]Sub Test()
Dim Arr()
Arr = GetData(ThisWorkbook.Path & "\A.xls", "Data")
Range("A2").Resize(UBound(Arr) + 1, UBound(Arr, 2) + 1).Value = Arr
End Sub

[/GPECODE]
 
Web KT
Back
Top Bottom