Lấy dữ liệu từ file đang đóng ( có password ) bằng ADO

Chia sẻ bởi:hands

★★★★★

‹ Đặt password hàng loạt file excel, thích... Điền excel vào word ›

Quảng cáo

Chào các anh chị,
Em có sưu tầm được code ở trên diễn đàn của anh HaiLuaMienTay, tuy nhiên, file excel nguồn của em có set password ( em biết pass ) nên chạy nó bị lỗi ạ. ( nếu chạy file bỏ password đi thì không sao )
Em tra google cũng không biết sửa, anh chị giúp em với ạ.
Em cám ơn ạ
5701

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 [OT$A2:AC65536]"
                lrs.Open lsSQL, cnn, 3, 1
                Sheets("Sheet1").Range("A2:AC65536").ClearContents
                Sheets("Sheet1").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

Cái này , nếu không nhớ nhầm, thì gần đây có topic đã đưa lên
– file có password mở file, thì cần phải có password
– cần mở ngầm để mở theo password đã có (nếu đã mở ngầm thì có khi sao cần ADO nữa, tất nhiên dùng ADO vẫn được)
—> tìm lại topic đó lại và xem

www.giaiphapexcel.com/diendan/threads/l%E1%BA%A5y-d%E1%BB%AF-li%E1%BB%87u-t%E1%BB%AB-file-%C4%91ang-%C4%91%C3%B3ng-c%C3%B3-password-b%E1%BA%B1ng-ado.147435/#post-953193