maidinhdan > 06-03-17, 06:41 PM
Tong so Mau tin Test: 8002
Bat dau vong lap: 12:29:01 AM
Thoi gian UpdateBatch 12:29:02 AM
Thoi gian UpdateBatch 12:29:03 AM
Thoi gian UpdateBatch 12:29:04 AM
Thoi gian UpdateBatch 12:29:05 AM
Thoi gian UpdateBatch 12:29:06 AM
Thoi gian UpdateBatch 12:29:07 AM
Thoi gian UpdateBatch 12:29:08 AM
Thoi gian UpdateBatch 12:29:09 AM
Ket thuc vong lap: 12:29:09 AM
Function ImportExcelToAccess()
Dim RsExcel As Object, SQL As String
Dim Strcon As String, LinkFileExcel As String, TenSheet As String, VungCopy As String, CotCuoicung As Long
Dim DongCuoiCung As Long
LinkFileExcel = CurrentProject.Path & "\Test.xlsx"
TenSheet = "Sheet1"
'Lay so dong tren File Excel
Dim oEx As New Excel.Application ' oEx la bien oExcel
Dim oBook As Workbook ' set oBook la tap hop oExcel
' Mo file can chen
Set oBook = oEx.Workbooks.Open(LinkFileExcel)
' Mo Sheet can chen
Dim oSheet As Worksheet ' set oSheet la tap hop Sheet
Set oSheet = oBook.Worksheets(TenSheet)
' Dem so dong, so cot
With oSheet.UsedRange
DongCuoiCung = .Rows(UBound(.Value)).Row
End With
oBook.Close False
Set oEx = Nothing
VungCopy = "A7:L" & DongCuoiCung ' Bat cau copy tu cot A7 den cot L xxx
' Mo File Excel
Set RsExcel = CreateObject("ADODB.Recordset")
SQL = "select * from [" & TenSheet & "$" & VungCopy & "]"
Strcon = ("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & LinkFileExcel _
& ";Extended Properties=""Excel 12.0 Xml;HDR=Yes;"";")
RsExcel.Open SQL, Strcon, 3, 1
''''''''''''
' Xoa du lieu trong tblTest
CurrentDb.Execute "DELETE * FROM tblTest", dbFailOnError 'Xoa tblTest
Dim i As Long
Dim RsAcc As New ADODB.Recordset
'Mo tblTest
RsAcc.Open "tblTest", CurrentProject.AccessConnection, _
adOpenstatic, adLockBatchOptimistic, adCmdTableDirect
'So dong moi lam UpdateBatch
Dim SoDongUpdateTrenLan As Integer, x As Integer
x = 0
SoDongUpdateTrenLan = 1000
With RsExcel
Debug.Print "Bat dau vong lap: ", Time
Do While Not .EOF ' Duyet mau tin tren Excel
RsAcc.AddNew
For i = 0 To (.Fields.Count - 1) ' Duyet mau tin tren Access
RsAcc.Fields(i).Value = .Fields.Item(i).Value
Next
.MoveNext
'So dong moi lam UpdateBatch
x = x + 1
If x = SoDongUpdateTrenLan Then ' 1000Dong Them 1 lan
RsAcc.UpdateBatch
Debug.Print "Thoi gian UpdateBatch", Time
x = 0
End If
Loop
Debug.Print "Ket thuc vong lap: ", Time
End With
MsgBox "Da Hoan thanh"
RsExcel.Close
Set RsExcel = Nothing
RsAcc.Close
Set RsAcc = Nothing
End Function