(Nguồn: http://www.excelguru.ca/node/20)
_Mục đích: Lấy dữ liệu từ bảng trong Access điền vào Listbox của Userform.
_Chú ý: không hiện tiêu đề cột.
_Phiên bản làm việc từ Ms Office 2003 trở về trước.
_Yêu cầu:
+ Tham chiếu đến "Microsoft ActiveX Data Objects Libary"
+ Chú ý đường dẫn tới bảng CSDL
+ Đoạn mã nên đặt vào thủ tục sự kiện Userform_Initialize
VBAVN
_Mục đích: Lấy dữ liệu từ bảng trong Access điền vào Listbox của Userform.
_Chú ý: không hiện tiêu đề cột.
_Phiên bản làm việc từ Ms Office 2003 trở về trước.
_Yêu cầu:
+ Tham chiếu đến "Microsoft ActiveX Data Objects Libary"
+ Chú ý đường dẫn tới bảng CSDL
+ Đoạn mã nên đặt vào thủ tục sự kiện Userform_Initialize
Mã:
Option Explicit
'Set reference to the Microsoft ActiveX Data Objects x.x Library!
'Global constants required
Const glob_sdbPath = "C:\Temp\FoodTest.mdb"
Const glob_sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & glob_sdbPath & ";"
Private Sub PopulateSuppliers()
'Author : Ken Puls ([URL="http://www.excelguru.ca/"]www.excelguru.ca[/URL])
'Macro Purpose: Populate the listbox with all values from the Access database
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim rcArray As Variant
Dim sSQL As String
'Set the location of your database, the connection string and the SQL query
sSQL = "SELECT tblSuppliers.SupplierName, tblSuppliers.SupplierNumber " & _
"FROM tblSuppliers ORDER BY tblSuppliers.SupplierName;"
'Open connection to the database
cnt.Open glob_sConnect
'Open recordset and copy to an array
rst.Open sSQL, cnt
rcArray = rst.GetRows
'Place data in the listbox
With Me.lbSuppliers
.Clear
.ColumnCount = 2
.List = Application.Transpose(rcArray)
.ListIndex = -1
End With
'Close ADO objects
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
End Sub
VBAVN