Nhờ sửa giùm đoạn code lấy dũ liệu từ nhiều file đóng (2 người xem)

[XuanTruong1958]

1/Tôi có khoảng gần 50 file có cấu trúc giống hệt nhau nằm ở khác thư mục chứa fille chạy. Đường dẫn của các file này nằm ở cột B của S01 file chạy, bắt đầu từ B1. Tôi muốn lấy dữ liều từ Sheet1 của các file đó trong vùng H10 : I500 đổ vào S02 file chạy, mỗi file ghi riêng ra các cột khác nhau. Ví dụ File1 ghi trong S02 từ B10 đến C500 thì File2 ghi tiếp sang phải từ D10 đến E500....
2/ Tôi sử dụng đoạn code sau

Sub Ghi()
    Application.ScreenUpdating = False
    Dim i As Long
    For i = 1 To S01.Range("B1000").End(xlUp).Row
        Dim cnn As Object
        Dim rst  As Object
        Dim SQL As String
        Set cnn = CreateObject("ADODB.connection")
        Set rst = CreateObject("ADODB.recordset")
        With cnn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Properties("Data Source") = S01.Range("B" & i)
            .Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
            .Open
        End With
        SQL = "SELECT * FROM [Sheet1$H10:I500]"
        rst.Open SQL, cnn, 3, 3
        S02.Cells(3, i * 2).CopyFromRecordset rst
        Set rst = Nothing
        cnn.Close:     Set cnn = Nothing
    Next
    MsgBox "Done!"
    Application.ScreenUpdating = True
End Sub
[php]

3/ Khi run code thì báo lỗi không tìm thấy "Sheet1$H10:I500 và bôi vàng dòng lệnh rst.Open SQL, cnn, 3, 3
Nhờ các bạn chỉ giúp lỗi ở đâu vì lâu ngày quá không dùng ADO
Cám ơn tất cả mọi người

 

[giaiphap]

1/Tôi có khoảng gần 50 file có cấu trúc giống hệt nhau nằm ở khác thư mục chứa fille chạy. Đường dẫn của các file này nằm ở cột B của S01 file chạy, bắt đầu từ B1. Tôi muốn lấy dữ liều từ Sheet1 của các file đó trong vùng H10 : I500 đổ vào S02 file chạy, mỗi file ghi riêng ra các cột khác nhau. Ví dụ File1 ghi trong S02 từ B10 đến C500 thì File2 ghi tiếp sang phải từ D10 đến E500....
2/ Tôi sử dụng đoạn code sau

Sub Ghi()
    Application.ScreenUpdating = False
    Dim i As Long
    For i = 1 To S01.Range("B1000").End(xlUp).Row
        Dim cnn As Object
        Dim rst  As Object
        Dim SQL As String
        Set cnn = CreateObject("ADODB.connection")
        Set rst = CreateObject("ADODB.recordset")
        With cnn
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Properties("Data Source") = S01.Range("B" & i)
            .Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
            .Open
        End With
        SQL = "SELECT * FROM [Sheet1$H10:I500]"
        rst.Open SQL, cnn, 3, 3
        S02.Cells(3, i * 2).CopyFromRecordset rst
        Set rst = Nothing
        cnn.Close:     Set cnn = Nothing
    Next
    MsgBox "Done!"
    Application.ScreenUpdating = True
End Sub
[php]

3/ Khi run code thì báo lỗi không tìm thấy "Sheet1$H10:I500 và bôi vàng dòng lệnh rst.Open SQL, cnn, 3, 3
Nhờ các bạn chỉ giúp lỗi ở đâu vì lâu ngày quá không dùng ADO
Cám ơn tất cả mọi người

Không có file làm sao biết bạn tham chiếu có đúng hay không mà mò.

 

[Hau151978]

Khả năng cnn chưa được khởi tạo.
.Properties("Extended Properties") = """Excel 12.0;HDR=NO;IMEX=1"""