DAO, ADO,QUERY TABLE với việc trích rút dữ liệu trong Excel.

  • Thread starter Thread starter sealand
  • Ngày gửi Ngày gửi
Liên hệ QC

sealand

Thành viên gạo cội
Tham gia
16/5/08
Bài viết
4,883
Được thích
7,688
Giới tính
Nam
Nghề nghiệp
Kế Toán
Nhân có bài của 1 bạn về việc dùng ADO trích rút dữ liệu như sau:
-Có 3 (n) file trong cùng thư mục với file Tonghop.xls như :TL01-10.xls, TL02-10.xls, TL03-10.xls ...
-Trong File Tonghop.xls có các Sheet: A1, A2,A3
-Dùng ADO để trích dữ liệu từ TL01-10.xls vào sheet A1, TL02-10.xls vào sheet A2, TL03-10.xls vào sheet A3

Mình dùng thử 3 dạng kết nối dữ liệu DAO, ADO,QUERY TABLE và thấy rằng cái nào cũng có cái hay của nó.
Để tiện cho việc tham khảo mình mạn phép mở Topic mới để các bạn trao đổi thêm và dễ tìm kiếm về sau:

Phần 1: Sử dụng ADO

Trước hết trong cửa sổ Module ta chuẩn bị viết Code ta phải tham chiếu đến 1 trong các thư viện Microsoft ActiveX Data Objects x.x Liabrary (Tốt nhất là phiên bản cao nhất Microsoft ActiveX Data Objects 2.8 Liabrary) bằng cách vào Tools--->Reference---> Chọn đánh dấu dòng có tên như trên trong danh sách.
Nhập đoạn code sau vào trong Module:

Mã:
Option Explicit
Sub ADO_EXCEL()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim strcn As String, strSQL As String, i
Dim FileNguon, FileName(), ShName()
    FileName = Array("TL01-10.xls", "TL02-10.xls", "TL03-10.xls")
      ShName = Array("A1", "A2", "A3")
       For i = 0 To UBound(FileName)
        FileNguon = ThisWorkbook.Path & "\" & FileName(i)
         strcn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
           "Data Source=" & FileNguon & ";" & _
             "Extended Properties=""Excel 8.0;HDR=No;IMEX=1"""
                strSQL = "SELECT * FROM [A$]"
              Set cn = New ADODB.Connection
             cn.CursorLocation = adUseClient
           cn.Open strcn
         Set rs = New ADODB.Recordset
       rs.Open strSQL, cn, adOpenKeyset, adLockReadOnly
     With Worksheets(ShName(i))
   .Cells.ClearContents
  .[A1].CopyFromRecordset rs
 .Columns.AutoFit
End With
Next
rs.Close: Set rs = Nothing
cn.Close: Set cn = Nothing
End Sub

Giờ ta có thể test sự hoạt động của nó. Code trong bài chỉ mới là cóp nhặt chưa phải là chuẩn mực. Mong các bạn hiệu đính giùm.
Các bạn tham khảo file ví dụ kèm theo (Trong file mình sử dụng 1 phần file danh sách trúng tuyển Đại học thương mại 2011 làm dữ liệu, mong thông cảm)

(Một lưu ý quan trọng là phải tải và giải nén thư mục ra ổ đĩa Code mới tìm thấy đường dẫn file)
 

File đính kèm

Lần chỉnh sửa cuối:
Phần 2: Sử dụng DAO

Trước hết trong cửa sổ Module ta chuẩn bị viết Code ta phải tham chiếu đến thư viện Microsoft DAO 3.6 Objects Liabrary bằng cách vào Tools--->Reference---> Chọn đánh dấu dòng có tên như trên trong danh sách. Đây là kỹ thuật "ruột" của MS Access (Anh em của Excel và khá mạnh trong làng CSDL)
Nhập đoạn code sau vào trong Module:
Mã:
Option Explicit
Sub GetWorksheetData()
 Dim db As DAO.Database, rs As DAO.Recordset
 Dim strSourceFile As String, strSQL As String, FileNguon, i, j
 Dim FileName(), ShName()
   FileName = Array("TL01-10.xls", "TL02-10.xls", "TL03-10.xls")
    ShName = Array("A1", "A2", "A3")
     For i = 0 To UBound(FileName)
      strSourceFile = ThisWorkbook.Path & "\" & FileName(i)
        strSQL = "SELECT * FROM [A$]"
         Set db = OpenDatabase(strSourceFile, 0, 1, "Excel 8.0;HDR=Yes;")
           Set rs = db.OpenRecordset(strSQL)
          With Worksheets(ShName(i))
        .Cells.ClearContents
       .[A2].CopyFromRecordset rs
      For j = 0 To rs.Fields.Count - 1
    .Cells(1, j + 1) = rs.Fields(j).Name
   Next
  End With
 Next
rs.Close: Set rs = Nothing
db.Close: Set db = Nothing
End Sub

Các bạn lại test với các file đã dùng cho bài trước.

(Một lưu ý quan trọng là phải tải và giải nén thư mục ra ổ đĩa Code mới tìm thấy đường dẫn file)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Em thì hay tạo hẳn 1 sub có tham số truyền cho dễ dùng
PHP:
Sub GetData(SrcFile As Variant, SrcSheet As String, SrcRange As String, Target As Range, Header As Boolean, UseHeaderRow As Boolean)
  Dim rsCon As Object, rsData As Object
  Dim szConnect As String, szSQL As String
  Dim lCount As Long
  If Val(Application.Version) < 12 Then
    szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & SrcFile & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(Header, "Yes", "No") & """;"
  Else
    szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & SrcFile & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(Header, "Yes", "No") & """;"
  End If

  If SrcSheet = "" Then
    szSQL = "SELECT * FROM " & SrcRange$ & ";"
  Else
    szSQL = "SELECT * FROM [" & SrcSheet$ & "$" & SrcRange$ & "];"
  End If
  
  On Error GoTo ExitSub

  Set rsCon = CreateObject("ADODB.Connection")
  Set rsData = CreateObject("ADODB.Recordset")

  rsCon.Open szConnect
  rsData.Open szSQL, rsCon, 0, 1, 1
   
  If Not rsData.EOF Then
    If Header = False Then
      Target.Cells(1, 1).CopyFromRecordset rsData
    Else
      If UseHeaderRow Then
        For lCount = 0 To rsData.Fields.Count - 1
          Target.Cells(1, 1 + lCount).Value = rsData.Fields(lCount).Name
        Next
        Target.Cells(2, 1).CopyFromRecordset rsData
      Else
        Target.Cells(1, 1).CopyFromRecordset rsData
      End If
    End If
  End If
  rsData.Close: Set rsData = Nothing
  rsCon.Close: Set rsCon = Nothing
ExitSub:
End Sub
Code dùng được trên cả Excel 2003 và Excel 2007
-----------------------------------------------------------
Còn phần duyệt các file trong thư mục lại là vấn đề khác rồi, em nghĩ không nên gộp chung vào phần lấy dữ liệu anh à
 
Upvote 0
Phần 3: Sử dụng Query Table

Đây là thư viện được tích hợp sẵn trong MS Excel, nhập đoạn code sau vào trong Module:
Mã:
Option Explicit
Sub Query_Exc()
    Application.ScreenUpdating = 0
    Dim FileNguon, i
    Dim FileName(), ShName()
      FileName = Array("TL01-10.xls", "TL02-10.xls", "TL03-10.xls")
       ShName = Array("A1", "A2", "A3")
        For i = 0 To UBound(FileName)
         FileNguon = ThisWorkbook.Path & "\" & FileName(i)
          ThisWorkbook.Worksheets(ShName(i)).Select
           With ActiveSheet
            .Cells.Clear
             .[a1].Select
           With .QueryTables.Add(Connection:=Array("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
          & FileNguon & ";Jet OLEDB:Engine Type=35"), Destination:=Selection)
         .CommandType = 3
        .CommandText = Array("A$")
       .Refresh BackgroundQuery:=False
       End With
      .UsedRange.Columns.AutoFit
    End With
    Next
End Sub

Các bạn test tiếp với các file ví dụ bài trước.

(Một lưu ý quan trọng là phải tải và giải nén thư mục ra ổ đĩa Code mới tìm thấy đường dẫn file)
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Code thực hiện như sau có ổn không nhỉ?
- Mở file TL01-10
- Copy và Paste vào sheet A1
- Đóng file TL01-10
 
Upvote 0
Phần 3: Sử dụng Query Table

Đây là thư viện được tích hợp sẵn trong MS Excel, nhập đoạn code sau vào trong Module:
Mã:
Option Explicit
Sub Query_Exc()
    Application.ScreenUpdating = 0
    Dim FileNguon, i
    Dim FileName(), ShName()
      FileName = Array("TL01-10.xls", "TL02-10.xls", "TL03-10.xls")
       ShName = Array("A1", "A2", "A3")
        For i = 0 To UBound(FileName)
         FileNguon = ThisWorkbook.Path & "\" & FileName(i)
          ThisWorkbook.Worksheets(ShName(i)).Select
           With ActiveSheet
            .Cells.Clear
             .[a1].Select
           With .QueryTables.Add([COLOR=#ff0000]Connection:=[/COLOR]Array("OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
          & FileNguon & ";Jet OLEDB:Engine Type=35"), Destination:=Selection)
         .CommandType = 3
        .CommandText = Array("A$")
       .Refresh BackgroundQuery:=False
       End With
      [COLOR=#ff0000].UsedRange.Columns.AutoFit[/COLOR]
    End With
    Next
End Sub

1. Có thể bỏ những chữ tô màu đỏ (ngắn thêm tí ti).
2. Nếu Sheet đầu tiên trong mỗi file không cùng tên là A (tên bất kỳ nhưng Sheet CodeName là Sheet1) thì câu lệnh .CommandText = Array("?$") viết như thế nào ?
 
Upvote 0
1. Có thể bỏ những chữ tô màu đỏ (ngắn thêm tí ti).
2. Nếu Sheet đầu tiên trong mỗi file không cùng tên là A (tên bất kỳ nhưng Sheet CodeName là Sheet1) thì câu lệnh .CommandText = Array("?$") viết như thế nào ?

Có 2 vấn đề ở đây:
1/Bỏ các đoạn màu đỏ: Hoàn toàn có thể được. Cái này ta gặp quá nhiều trong code tự viết so với code Record. Nhưng để tham khảo vẫn dễ nhìn hơn. Trong thực tế khi viết code người ta cũng có thể thay tham số bằng Index của tham số giống như: Selection.End(XlUp) và Selection.End(3). Các tham số trống sẽ lấy theo Defauld. Nhưng có 1 khác biệt là nếu không ghi rõ Title của tham số thì phải bắt buộc có n dấu phảy cho n tham số cho đến tham số do Users thiết lập.
Dòng đỏ thứ 2 chỉ là định dạng bảng tính mà thôi.

2/Một trong vấn đề lập trình trong các Form ta có thể đặt tên theo index khi viết code sẽ rất tiện lợi cho việc sử lý. Nhưng với Sh name và file name e không ổn, người dùng thay đổi 1 chút là vỡ code. Trường hợp này thực tế phải viết hàm liệt kê file trong thư mục, liệt kê Sh trong file có đầy đủ và hợp lệ không? Cách mình viết như trên nhằm giảm bớt 1 công đoạn không phải là chủ đề cần đề cập ở Topic này mà thôi.

Chibi đã viết:
Code thực hiện như sau có ổn không nhỉ?
- Mở file TL01-10
- Copy và Paste vào sheet A1
- Đóng file TL01-10

Bác ơi, vấn đề đó trên GPE có nhiều rồi mà, nhưng thực ra nó "du kích" lắm. Tốc độ thì chậm nhiều.
Cái chính ở đây, em muốn đề cập là :
-Làm sao biến Excel ngoài viêc nó là bảng tính nó còn là 1 CSDL thực sự cơ. Để sử dụng hàng triệu dòng trong Exc 2007 trở lên mà chỉ dùng kỹ thuật công thức Exc không thì đó là điều không tưởng. Các máy tính hiên nay cũng không thể tính toán kịp.
-Tận dụng sức mạnh của ngôn ngữ SQL . Điều này trước đây khi mới biết A-tools của anh Tuân mà mình choáng và thèm vô cùng.
-Một điều nữa: Thoả chí tò mò, quậy của anh em ta.
 
Lần chỉnh sửa cuối:
Upvote 0
2. Nếu Sheet đầu tiên trong mỗi file không cùng tên là A (tên bất kỳ nhưng Sheet CodeName là Sheet1) thì câu lệnh .CommandText = Array("?$") viết như thế nào ?
Trong code của em, nếu anh khai báo tên sheet = "" thì có nghĩa là lấy sheet đầu tiên
Mời xem cách em làm ở đây:
http://www.giaiphapexcel.com/forum/showthread.php?54452-Tổng-hợp-nhiều-file-Excel-trong-một-thư-mục
 
Upvote 0
Lần chỉnh sửa cuối:
Upvote 0
Thân chào các thành viên tham gia chủ đề này.

Thật lòng rất cảm ơn sự quan tâm của các Anh Chị Em.

Có 1 chút hiểu lầm ý của Em. Em xin được trình bày thêm như sau:

Trong các file TL01-10.xls, TL02-10.xls, TL03-10.xls ... đều có các sheet A,B,C
Mở file Tonghop.xls lên trong file mày không có các sheet A1,A2,A3
Dùng code lấy dữ liệu từ file đóng bằng phương thức ADO để copy sheet A trong file TL01-10.xls sang file Tonghop.xls và đặt tên là A1, copy sheet A trong file TL02-10.xls sang file Tonghop.xls và đặt tên là A2, copy sheet A trong file TL03-10.xls sang file Tonghop.xls và đặt tên là A3,... tương tự cho hết các file trong cùng thư mục với file Tonghop.xls
Thêm 1 điều nữa là em muốn giữ nguyên định dạng của sheet A trong file TL01-10.xls khi copy sang sheet A1, sheet A trong file TL02-10.xls khi copy sang sheet A2,sheet A trong file TL03-10.xls khi copy sang sheet A3.

Rất mong nhận được hồi âm.

Thân chào
 
Lần chỉnh sửa cuối:
Upvote 0
To Thien: Bạn nên trở về Topic của mình và có ví dụ cụ thể mình sẽ làm lại cho bạn, tránh làm đi làm lại vì đây cũng là điển hình cho việc đoán sai.
 
Upvote 0
Cái chính ở đây, em muốn đề cập là :
-Làm sao biến Excel ngoài viêc nó là bảng tính nó còn là 1 CSDL thực sự cơ. Để sử dụng hàng triệu dòng trong Exc 2007 trở lên mà chỉ dùng kỹ thuật công thức Exc không thì đó là điều không tưởng. Các máy tính hiên nay cũng không thể tính toán kịp.
-Tận dụng sức mạnh của ngôn ngữ SQL . Điều này trước đây khi mới biết A-tools của anh Tuân mà mình choáng và thèm vô cùng.
-Một điều nữa: Thoả chí tò mò, quậy của anh em ta.

việc cố gắng dùng excel làm một CSDL "thực sự" là không nên, trước đây tui cũng hay làm vậy, nhưng giờ thường đẩy dữ liệu sang access thấy an toàn hơn.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom