- Tham gia
- 18/3/08
- Bài viết
- 8,310
- Được thích
- 15,867
- Giới tính
- Nam
- Nghề nghiệp
- Làm ruộng.
Tiếp chiêu bài ADO: Kết nối Excel Database cho công việc kế toán của Thầy Mỹ (Ptm0412) và Kết nối giữa các file Excel bằng ADODC. của anh Sealand em viết bài này về việc kết nối và truy vấn với file excel dữ liệu khác trên userform, mong các anh chị hướng dẫn thêm.
Chuẩn bị:
Tạo 1 Userform và các control như hình:
Code trong module:
Kết nối với dữ liệu nguồn là file Excel:
Code trong form:
Chuẩn bị:
Tạo 1 Userform và các control như hình:
Code trong module:
Kết nối với dữ liệu nguồn là file Excel:
Mã:
Public cnn As New ADODB.Connection
Sub Moketnoi()
Dim i, r As Integer
Set cnn = New ADODB.Connection
With cnn
.ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0; data source=" & ThisWorkbook.Path & _
"\Database.xls;Extended Properties=Excel 8.0;"
.CursorLocation = adUseClient
.Open
End With
End SubCode trong form:
Mã:
Dim rst As ADODB.Recordset
Private Sub FillcbOrder()
On Error Resume Next
Dim lsSQL As String
Dim lrs As New ADODB.Recordset
lsSQL = "select distinct [ORDER] " & _
"From [Dulieu$] " & _
"ORDER BY [ORDER]"
lrs.Open lsSQL, cnn, adOpenStatic, adLockReadOnly
cbOrder.Clear
Do Until lrs.EOF
cbOrder.AddItem lrs![Order]
lrs.MoveNext
Loop
Set lrs = Nothing
End Sub
Private Sub cmdExcel_Click()
On Error GoTo ErrHandle
Dim iNumCols, i As Integer
Dim lsSQL As String
Dim lrs As New ADODB.Recordset
lsSQL = "SELECT * FROM [Dulieu$] where [ORDER] like '" & cbOrder.Text & "' order by id"
lrs.Open lsSQL, cnn, 1, 3
If lrs.EOF Then
MsgBox "Could not find your data, Please try again", vbCritical
Else
Cells.ClearContents
iNumCols = lrs.Fields.Count
For i = 1 To iNumCols
With Sheet1
.Cells(3, i).Value = lrs.Fields(i - 1).Name
.Cells(3, i).Font.Bold = True
.Cells(3, i).Font.ColorIndex = 5
With .Cells(3, i).Interior
.ColorIndex = 34
End With
End With
Next
Range("A4").CopyFromRecordset lrs
End If
Set lrs = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Description
End Sub
Private Sub cmdFillList_Click()
On Error GoTo ErrHandle
Dim iNumCols, i As Integer
Dim lsSQL As String
Dim lrs As New ADODB.Recordset
lsSQL = "SELECT * FROM [Dulieu$] where [ORDER] like '" & cbOrder.Text & "' order by id"
lrs.Open lsSQL, cnn, 1, 3
If lrs.EOF Then
MsgBox "Could not find your data, Please try again", vbCritical
Else
Set msgInfo.DataSource = lrs
End If
Set lrs = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Description
End Sub
Private Sub UserForm_Initialize()
Moketnoi
On Error Resume Next
FillcbOrder
Dim rs As New ADODB.Recordset
Set rs = Nothing
rs.Open "Select * from [Dulieu$] order by id", cnn, 1, 3
Set msgInfo.DataSource = rs
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
cnn.Close
Set cnn = Nothing
End Sub
