Sử dụng ADO lấy dữ liệu

[thuong1216]

Lời đầu tiền xin gửi lời cảm ơn chân thànhvà chúc sức khỏe đến Ban quản trị và các thành viên GPE.

Hiện tại em có đang sử dụng 1 code của anh chim_hong được chia sẻ trên diễn đàn GPE để copy dữ liệu từ các file đóng vào 1 file tổng hợp.
Code:

Public Sub chim_hong()
Dim cn As Object, cat As Object, filename, sheetname As String, tbl As Object, vFile
On Error Resume Next
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
vFile = Application.GetOpenFilename("Excel File, *.xl*", , , , True)
If TypeName(vFile) = "Variant()" Then
    For Each filename In vFile
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";mode=read;Extended Properties=""Excel 12.0;HDR=no"";"
        Set cat.ActiveConnection = cn
        For Each tbl In cat.tables
            If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
                sheetname = " [" & Replace(tbl.Name, "'", "") & "A15:BI20000]"
                Sheet1.Range("A100000").End(xlUp).Offset(1) _
                .CopyFromRecordset cn.Execute("select * from " & sheetname)
            End If
        Next
        cn.Close
    Next
End If
End Sub

Kính nhờ các Anh/Chị giúp đỡ chỉnh sửa đoạn code trên cho nội dung sau:
1) Em muốn lấy ngày tại cột $F$11 của file nguồn để dán thay thế vào cột A (số thứ tự dòng) của từng file nguồn trước khi copy sang file tổng hợp, hoặc dán vào file tổng hợp luôn cũng được.
2) Tại file tổng hợp em muốn tạo thêm nhiều sheetname tổng hợp khác sử dụng chung đoạn code trên để lấy dữ liệu từ nhiều nguồn khác nhau. Hiện tại đoạn code trên nếu tạo thêm sheetname mới thì dữ liệu copy về sẽ nhảy vào sheet đầu tiên trong file Tổng hợp.

Rất mong nhận được sự giúp đỡ từ quý Anh/Chị thành viên GPE.

 

[AutoReply]

Lời đầu tiền xin gửi lời cảm ơn chân thànhvà chúc sức khỏe đến Ban quản trị và các thành viên GPE.

Hiện tại em có đang sử dụng 1 code được chia sẻ trên diễn đàn GPE để copy dữ liệu từ các file đóng vào 1 file tổng hợp.
Code:

Public Sub chim_hong()

Ủa sao tên Sub nhìn ngộ ha bạn ? nó có nghĩa là gì vậy bạn ?

 

[thuong1216]

Ủa sao tên Sub nhìn ngộ ha bạn ? nó có nghĩa là gì vậy bạn ?

Sub code này em copy y nguyên trên GPE. nên em giữ nguyên theo tên sub của người viết code khi paste lên diễn đàn ạ

 

[AutoReply]

Sub code này em copy y nguyên trên GPE. nên em giữ nguyên theo tên sub của người viết code khi paste lên diễn đàn ạ

Cũng hơi lạ nhỉ, tên gì không đặt lại đặt tên là chim !
Theo mục đích sử dụng của mấy file bạn gửi thì không nhất thiết phải code cầu kì thế, nhưng mình cũng không có nhiều thời gian nên thôi sửa thành vầy cũng tạm. Code đầu đặt tên chim giờ cũng giữ tên chim ... Không biết là cái tên nào quái gở vậy ta.

Public Sub chim_hong()
Dim cn As Object, cat As Object, filename, sheetname As String, tbl As Object, vFile
On Error Resume Next
Set cn = CreateObject("ADODB.Connection")
Set cat = CreateObject("ADOX.Catalog")
vFile = Application.GetOpenFilename("Excel File, *.xl*", , , , True)
If TypeName(vFile) = "Variant()" Then
    For Each filename In vFile
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";mode=read;Extended Properties=""Excel 12.0;HDR=no"";"
        Set cat.ActiveConnection = cn
        For Each tbl In cat.tables
            If Right(tbl.Name, 1) = "$" Or Right(tbl.Name, 2) = "$'" Then
                sheetname = " [" & Replace(tbl.Name, "'", "") & "B15:BI20000]"
                Sheet1.Range("A100000").End(xlUp).Offset(1) _
                .CopyFromRecordset cn.Execute("select " & _
                "(select f1 from [" & Replace(tbl.Name, "'", "") & "F11:F11])," & _
                "* from " & sheetname)
            End If
        Next
        cn.Close
    Next
End If
End Sub