Copy dữ liệu từ file đang đóng (1 người xem)

[BuiQuangThuan]

Hiện tại em em có 2 file cấu trúc dữ liệu giống nhau nhưng không nằm trên 1 foder. Em muốn copy toàn bộ dữ liệu của file "File du lieu" sang file " TONGHOP". Cũng tìm hiểu trên diễn đàn nhưng khi làm lại không ra kết quả được. Chính vì vậy nhờ các thầy cô kiểm tra giúp module trong file TONGHOP xem em đang sai chỗ nào? Hoặc nhờ thầy cô xử lí giúp ạ.

 

[befaint]

Thử tham khảo:

Python với Excel - Đọc và ghi dữ liệu giữa các files Excel

Xem bài viết Python với Excel - Mở đầu và cài đặt thư viện để cài đặt Python và thư viện cần thiết. Mượn chủ đề này: Lỗi Khi lấy dữ liệu bằng ADO để viết xử lý bằng Python. Mô tả: Cần lấy dữ liệu ở một file1 và ghi vào một file2 khác. Công việc lặp lại theo chu kỳ/ yêu cầu nào đó, dữ liệu mới...

www.giaiphapexcel.com

 

[BuiQuangThuan]

Thử tham khảo:

Python với Excel - Đọc và ghi dữ liệu giữa các files Excel

Xem bài viết Python với Excel - Mở đầu và cài đặt thư viện để cài đặt Python và thư viện cần thiết. Mượn chủ đề này: Lỗi Khi lấy dữ liệu bằng ADO để viết xử lý bằng Python. Mô tả: Cần lấy dữ liệu ở một file1 và ghi vào một file2 khác. Công việc lặp lại theo chu kỳ/ yêu cầu nào đó, dữ liệu mới...

www.giaiphapexcel.com

có cách nào xử lý được không thầy cô. tại em sử dụng máy công ty. bị quản lý used. không tiện cài vào máy đươc. 1 điều nữa là khi muốn sang 1 máy khác cũng phải cài cái đó đúng không ạ

 

[Hai Lúa Miền Tây]

có cách nào xử lý được không thầy cô. tại em sử dụng máy công ty. bị quản lý used. không tiện cài vào máy đươc. 1 điều nữa là khi muốn sang 1 máy khác cũng phải cài cái đó đúng không ạ

Tạm thời tôi chỉ sửa code theo yêu cầu bài 1 của bạn như sau:

Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object ', Fname
    Dim Fso As Object, Link As String ', shNameNguon, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    'shNameNguon = Array("aaa")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
        
        'For Each Fname In .SelectedItems
          
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
           '    Fname = .SelectedItems
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
            
            'For i = 0 To UBound(shNameNguon)
          
                lsSQL = "SELECT * FROM [aaa$A2:AC65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets("aaa").Range("A2:AC65536").ClearContents
                Sheets("aaa").Range("A2").CopyFromRecordset lrs
                lrs.Close
            'Next
            End With
        'Next
    End With
 
    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub

 

[BuiQuangThuan]

Tạm thời tôi chỉ sửa code theo yêu cầu bài 1 của bạn như sau:

Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object ', Fname
    Dim Fso As Object, Link As String ', shNameNguon, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    'shNameNguon = Array("aaa")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
       
        'For Each Fname In .SelectedItems
         
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
           '    Fname = .SelectedItems
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
           
            'For i = 0 To UBound(shNameNguon)
         
                lsSQL = "SELECT * FROM [aaa$A2:AC65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets("aaa").Range("A2:AC65536").ClearContents
                Sheets("aaa").Range("A2").CopyFromRecordset lrs
                lrs.Close
            'Next
            End With
        'Next
    End With

    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub

con cám ơn chú ạ

 

[M@trixs]

Mình có nhiều file như vậy thì làm sao để click chọn file khác thì nó sẽ chép tiếp vào dòng cuối cùng bạn ơi ?
Mong bạn giúp mình với, xin cảm ơn nhiều !

Tạm thời tôi chỉ sửa code theo yêu cầu bài 1 của bạn như sau:

Sub TongHop()
    Dim cnn As Object, lsSQL As String, lrs As Object ', Fname
    Dim Fso As Object, Link As String ', shNameNguon, i As Long
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set cnn = CreateObject("ADODB.Connection")
    Set lrs = CreateObject("ADODB.Recordset")
    'shNameNguon = Array("aaa")
    Application.ScreenUpdating = False

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Microsoft Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm", 1
        If .Show = -1 Then
            Link = .InitialFileName
        Else
            MsgBox "Ban da khong chon tong hop", vbInformation, "Thông Báo"
            Exit Sub
        End If
      
        'For Each Fname In .SelectedItems
        
            With cnn
                If Val(Application.Version) < 12 Then
                    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
                                      & "Data Source=" & Fname & ";Extended Properties=""Excel 8.0;HDR=No"";"
                Else
           '    Fname = .SelectedItems
                    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                                      & "Data Source=" & Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1) & ";Extended Properties=""Excel 12.0;HDR=No"";"
                End If
                .Open
          
            'For i = 0 To UBound(shNameNguon)
        
                lsSQL = "SELECT * FROM [aaa$A2:AC65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets("aaa").Range("A2:AC65536").ClearContents
                Sheets("aaa").Range("A2").CopyFromRecordset lrs
                lrs.Close
            'Next
            End With
        'Next
    End With

    Application.ScreenUpdating = True
    cnn.Close
    Set lrs = Nothing
    Set cnn = Nothing
End Sub