(06-03-17, 06:41 PM)maidinhdan Đã viết: Demo_Code Import IMPORT/EXPORT EXCEL-ACCESS và CÁC HÀM LIỆT KÊ TÊN SHEET, TABLE, QUERY, FORM, REPORT, MACRO, MODULES VÀO COMBOBOX

Công dụng:
- Nhập/Xuất giữa Excel và Access: Bạn có thể xoá table + file Excel trong bản Demo này và thay thế bằng table + file Excel của bạn nó vẫn chạy ầm ầm ( Lưu ý: Riêng file Excel dòng đầu tiên là dòng tiêu đề nhé, nếu bạn nào có nhu câu thay dòng đâu tiên thành dòng thứ mấy thì xem trong code mình có ghi chú)


- Liệt kê tên Table, query, form, Macro, report, Modules


Có nhiều Code dành cho ai đam mê học tập nghiên cứu: nhất là liên quan đến Vòng lặp và duyệt mãng (Array)

Hình minh hoạ

Nếu để sử dụng thì tải theo địa chỉ ở dưới.

Nếu muốn tải về để học tập thì vui lòng để lại Email để mình gửi bản *.mdb để xem code

Thân mến!

'Bổ sung Code mới UpdateBatch ngày 16/11/2018
Đoạn này có ý nghĩa như sau: Thay vì con trỏ đi qua 1 mẫu tin thì update 1 lần, tương đương 1 dòng. Thì
Thứ 1, đoạn code này nó sẽ canh đủ 1000 dòng mới ra lệnh Update.
Thứ 2, Không gây ra hiện tượng treo/lag khi load trên 10.000 dòng.
Thứ 3, Rút ngắn thời gian Import dù cho bạn Update 1 triệu mẫu tin đi chăng nửa.

* Cuối cùng đoạn code này bạn có thể áp dụng với SQL Server to Access còn nhanh hơn nửa, chỉ cần chỉnh lại chuỗi kết nối là ok.
* Về mặc hạn chế của code này đó là: phải mở Excel 2 lần
1. Mở Excel lần 1, để xác định tổng số dòng cần Import ( Tốn khoảng 1 giây) rồi nó sẽ đóng lại sau khi đếm số mẫu tin.
2. Mở lần 2 để tiến hành Add vào Access.

Kết quả test

Mã PHP:

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 


Demo Link Download GoogleDrive

Code Minh Họa

Mã PHP:

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 


Chúc bạn vui khỏe

e xin file tham khảo ạ. mail: hoaithanh9480@gmail.com

Đã gửi

(04-09-17, 04:23 PM)huuduy.duy Đã viết: Cho em xin 1 bản vô mail: huuduy.duy@gmail.com
Cám ơn anh nhiều

Chào anh!
Anh gởi cho em xin lại phiên bản mới nhất ạ. (Em đã có bản của năm 2017 ạ)

Trân trọng cảm ơn anh!

(17-08-20, 12:04 PM)huuduy.duy Đã viết:

(04-09-17, 04:23 PM)huuduy.duy Đã viết: Cho em xin 1 bản vô mail: huuduy.duy@gmail.com
Cám ơn anh nhiều

Chào anh!
Anh gởi cho em xin lại phiên bản mới nhất ạ. (Em đã có bản của năm 2017 ạ)

Trân trọng cảm ơn anh!

Đã gửi lần trước xem lại nhé

Mình đang cần code để làm chương trình nhỏ, xin bác maidinhdan file mdb tham khảo. Cảm ơn Bác. Bác gửi qua Elmail:vanphongdx@gmail.com 

Cám ơn bác Maidinhdan,  Bác gửi cho mình bản xem được code nhé!? Mail: songlong1424@gmail.com. Cám ơn nhiều

Đã gửi 2 mail trên

(16-11-18, 01:26 AM)maidinhdan Đã viết:

(15-11-18, 03:18 PM)hoabattu3387 Đã viết:  mình có test thử lấy dữ liêu từ excel vào access bằng cách sử dụng phương thức addnew của recordset . Tuy nhiên đối với dữ liệu khoảng vài nghìn dòng thì phải mất mấy phút mới import xong. vậy có cách nào nhanh hơn không mong bạn chỉ giáo (vì mình phải import nhiều file mà mỗi file vài nghìn dòng)

Đây là đoạn code bạn cần tìm:
Mình đã Test với File với 8000 mẫu tin, cho Add 1000mẫu/Lần, trung bình 1000mẫu là 1 giây.
Kết quả test

Mã PHP:

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 


Demo Link Download GoogleDrive

Code Minh Họa

Mã PHP:

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 


Chúc bạn vui khỏe

Cảm ơn file demon của anh. mà khi đưa dữ liệu theo kiểu này thì dữ liệu cũ bị mất trong "tblTest", ở đây mình muốn dữ liễu cũ vẫn dữ nguyên, khi import thì dữ liệu mới thêm mới vào file "tblTest". Vậy cần chỉnh code chổ nào Anh nhỉ?

(27-02-21, 08:43 AM)thanhtruong Đã viết: Cảm ơn file demon của anh. mà khi đưa dữ liệu theo kiểu này thì dữ liệu cũ bị mất trong "tblTest", ở đây mình muốn dữ liễu cũ vẫn dữ nguyên, khi import thì dữ liệu mới thêm mới vào file "tblTest". Vậy cần chỉnh code chổ nào Anh nhỉ?

Bạn đọc code không kỹ rồi.
Bỏ dòng code này đi là không xoá dữ liệu cũ:

Đối với việc Import từ Excel vào Access, nếu dùng mảng sẽ nhanh hơn nhiều thay vì dùng ADODB kết nối tới file Excel.
- Mở Excel lên, lấy vùng cần import gán vào mảng.
- Duyệt mảnh để lưu dữ liệu vào table Access.

Kiểm tra với 8.000 mẫu tin chỉ có 2 - 3 giây => bằng 1/3 thời gian so với cách trên.

Code: