VBA tăng perfromance đọc file Excel bằng cách sử dụng ADODB

VBA tăng perfromance đọc file Excel bằng cách sử dụng ADODB
Với mục đích cần tổng hợp data từ nhiều file excel khác nhau, thì có rất nhiều cách để các bạn đọc một hoặc nhiều file excel. Thông thường, rất nhiều người hay sử dụng (và cũng rất dễ tìm kiếm trên google) là cách sử dụng câu lệnh Open từng file, lấy data và dùng câu lệnh Close nó. Dưới đây là 2 ví dụ điển hình:

VD1:

Dim wb As Workbook

For i = LBound(MyFiles) To UBound(MyFiles)

    Set wb = Workbooks.Open(MyPath & MyFiles(i), 0, True)

    'lấy data từ wb …..

    wb.Close (False)

Next

VD2:

Dim xApp As New Excel.Application

For i = LBound(MyFiles) To UBound(MyFiles)

    With xApp

        .Workbooks.Open FileName:=MyPath & MyFiles(i), ReadOnly:=True

        .Visible = False

    End With

         'lấy data từ wb …..

    xApp.ActiveWorkbook.Close False

Next

Cả 2 ví dụ trên đều thực hiện thành công và đáp ứng nhu cầu của coder nhưng có performance rất chậm. Tôi áp dụng nó để mở và lấy data từ 1 file TC có size = 3MB, trong đó có 5k ITC thì kết quả như sau:
Ở VD1 -> mất 35 giây.
Ở VD2 -> mất 48 giây.
Bạn hãy tưởng tượng, dự án tôi có 4 file như vậy và hàng ngày tôi cần tổng hợp để xem số liệu create, execute (Không muốn dựa vào report của các leader, tôi muốn xem số thực tế). Và mỗi lần chạy mất 3 phút chỉ cho việc đọc file L, tôi chắc rằng ở FSOFT có rất nhiều dự án có số lượng document khủng của UTC, ITC, DD,…
Tôi đã tìm hiểu, rồi thử với ADODB thì kết quả rất bất ngờ: Tôi đặt log time và việc đọc 4 file ITC đã chỉ còn 6 giây thay vì 3 phút. Các bạn hãy thử sửa VBA của mình và chạy lại đi, đừng ngạc nhiên nhé!
Đây là 1 ví dụ về việc sử dụng ADODB, nếu bạn nào vẫn chưa rõ thì liên hệ qua Account Teams TruongVX tôi sẽ hướng dẫn thêm. Nhớ add thư viện "Microsoft ADO Ext. 6.0 for DDL and Security", "Microsoft.ACE.OLEDB.12.0"

Sub GetDataFromExcelFileWithADODB(path As String, sheetname As String, _

                                    startRow As Integer, StartColumn As Integer, _

                                    endRow As Integer, EndColumn As Integer)

On Error Resume Next

    Dim cnStr As String

    Dim rs As ADODB.Recordset

    Dim query As String  

    Call OptimizeCode_Begin  

    With ActiveSheet

    sheetrange = .Range(.Cells(startRow, StartColumn), _

                      .Cells(endRow, EndColumn)).Address()

    End With

    sheetrange = Replace(sheetrange, "$", "")

    cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _

               "Data Source=" & path & ";" & _

               "Extended Properties=Excel 12.0"

    query = "SELECT * FROM [" & sheetname & "$" & sheetrange & "]"

    Set rs = New ADODB.Recordset

    rs.Open query, cnStr, adOpenStatic, adLockReadOnly

    Range("B4").CopyFromRecordset rs

    Dim cell As Range, i As Long

    With Range("A1").CurrentRegion

        For i = 0 To rs.Fields.Count - 1

            .Cells(2, i + 1).Value2 = rs.Fields(i).Name

        Next i

        .EntireColumn.AutoFit

    End With  

    rs.Close  

    Call OptimizeCode_End

End Sub

* Lưu ý:

Khi sử dụng ADODB thì cần phải giải phóng nó sau khi sử dụng nhé, không thì nó sẽ tốn RAM lắm đấy!
Câu lệnh giải phóng biến khai báo kiểu ADODB:
Tên biến.Close -> VD ở trên đang sử dụng rs.Close
Tác giả: Vu Xuan Truong (ICS.YDC)