Bình tham khảo ví dụ của mình dưới đây, nếu không rõ chỗ nào thì mình giải thích.
Function GetConnMDB(ByVal cFileName As String) As ADODB.Connection
On Error GoTo loi:
'Open the ADO connection to the Excel workbook
Dim oconn As ADODB.Connection
Set oconn = New ADODB.Connection
oconn.Open "provider=microsoft.jet.oledb.4.0; data source=" & cFileName
Set GetConnMDB = oconn
loi:
Set oconn = Nothing
If err.Number <> 0 Then Set GetConnMDB = Nothing
End Function
Function GetRS(ByVal cVung As String, ByVal oconn As ADODB.Connection) As ADODB.Recordset
On Error GoTo loi:
'Get the table name from the dropdown
Dim sTableName As String
sTableName = cVung
'Get the recordset
Dim oRS As ADODB.Recordset
Set oRS = New ADODB.Recordset
On Error GoTo loi:
oRS.Open sTableName, oconn, adOpenStatic, adLockOptimistic
Set GetRS = oRS
loi:
Set oRS = Nothing
If err.Number <> 0 Then Set GetRS = Nothing
End Function
Sub LoadDataToSheet()
Dim oconn As ADODB.Connection
Dim oRS As ADODB.Recordset
Set oconn = GetConnMDB("CHUNGTU.MDB")
cSQL = "Select * from Dmhang"
Set oRS = GetRS(cSQL, oconn)
Range("A1").CopyFromRecordset oRS
End Sub
Sub NHAP()
Dim oconn As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim WS As Worksheet
Set WS = Worksheets("phieuchi")
cFile = "CHUNGTU.MDB"
Set oconn = GetConnMDB(cFile)
cSQL = "NHATKY"
Set oRS = GetRS(cSQL, oconn)
oRS.AddNew
oRS.Fields("NGAYCT").Value = DateValue(WS.Range("W9").Value & "/" & WS.Range("Q9").Value & "/" & WS.Range("AC9").Value)
oRS.Fields("SOHIEUCT").Value = WS.Range("AI6").Value
oRS.Fields("DIENGIAI").Value = WS.Range("G16").Value
oRS.Fields("DVKH").Value = WS.Range("L14").Value
oRS.Fields("SLGTIEN").Value = WS.Range("G17").Value
oRS.Fields("TYGIA").Value = WS.Range("X17").Value
oRS.Fields("LOAITIEN").Value = WS.Range("O17").Value
oRS.Fields("ttIEN").Value = WS.Range("G17").Value * WS.Range("X17").Value
oRS.Fields("NOTK").Value = WS.Range("AJ11").Value
oRS.Fields("COTK").Value = WS.Range("AJ12").Value
oRS.Fields("DTCF").Value = WS.Range("I16").Value
oRS.Update
MsgBox "Ok!"
Set oRS = Nothing
Set oconn = Nothing
Set WS = Nothing
End Sub