• Tùy chọn
• Đăng nhập
• Đăng ký
• Xem như trên Máy tính
• Accelerated Mobile Pages Theme

[Demo p1] Import/Export Excel + Hàm Liệt tên ALL Access

• Trang chủ

  • Thủ Thuật Access
  • Access Nâng Cao
  • Tương tác Chương trình ngoài
  • [Demo p1] Import/Export Excel + Hàm Liệt tên ALL Access
• [Demo p1] Import/Export Excel + Hàm Liệt tên ALL Access

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  hoaithanh > 03-08-20, 11:18 AM

  (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

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  maidinhdan > 11-08-20, 01:23 PM

  Đã gửi

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  huuduy.duy > 17-08-20, 12:04 PM

  (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!

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  maidinhdan > 26-08-20, 03:56 PM

  (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é

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  vanphongdx76 > 05-11-20, 12:23 AM

  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 

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  songlong1424 > 27-12-20, 12:16 PM

  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

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  maidinhdan > 19-01-21, 02:47 PM

  Đã gửi 2 mail trên

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  thanhtruong > 27-02-21, 08:43 AM

  (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ỉ?

• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  ongke0711 > 27-02-21, 09:47 AM

  (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ũ:
  
  

  Mã PHP:

  CurrentDb.Execute "DELETE * FROM tblTest", dbFailOnError 'Xoa tblTest 


• RE: Demo Import/Export Excel + Hàm Liệt tên ALL Access

  ongke0711 > 27-02-21, 10:52 AM

  Đố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: 

  Mã PHP:

  Function ImportExcelToAccess2()
    Dim arrData() As Variant
    Dim i As Integer, j As Integer
    Dim LinkFileExcel As String, TenSheet As String
    Dim DongCuoiCung As Long, CotCuoicung As Long

    LinkFileExcel = CurrentProject.Path & "\Test.xlsx"
    TenSheet = "Sheet1"
    
    Debug.Print "Bat dau vong lap: ", Time
    
    '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(.Rows.Count).Row
        CotCuoicung = .Columns(.Columns.Count).Column
    End With

    arrData = oSheet.Range("A6:L" & DongCuoiCung)
    oBook.Close False
    Set oEx = Nothing


    Dim rs As DAO.Recordset
    Set rs = CurrentDb.OpenRecordset("tblTest", dbOpenDynaset)
    For i = 2 To UBound(arrData)
        rs.AddNew
        For j = 1 To CotCuoicung
            rs.Fields(arrData(1, j)).Value = arrData(i, j)
        Next j
        rs.Update
    Next i
    
    Debug.Print "Ket thuc vong lap: ", Time
    
    rs.Close
    Set rs = Nothing


End Function 

• Bài trước Bài tiếp