Hỏi cách Sử dụng ADO để lấy dữ liệu trong Excel

[challenge98]

Em đang nghiên cứu về ADO để phục vụ cho công việc nhưng kiến thức còn hạn chế lắm cụ thể là bây giờ em có 2 file excel là tonghop.xls và baogia.xls em muốn ở bên file tonghop.xls có nút lấy dữ liệu từ file baogia.xls. đang làm dở nhưng khó quá nhờ mọi người chỉ giúp.

 

[cadafi]

Bạn nghiên cứu thêm ở link bên dưới nhé!

http://www.giaiphapexcel.com/forum/showthread.php?t=25759

 

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

Bạn chép đoạn sau vào Module

Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long
    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If
    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If
    On Error GoTo SomethingWrong
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")
    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then
        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If
    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub
SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0
End Sub

Và chạy đoạn sau:

Sub NhapDuLieu()
    Dim SaveDriveDir As String, MyPath As String
    Dim FName As Variant
    SaveDriveDir = CurDir
    MyPath = Application.DefaultFilePath
    ChDrive MyPath
    ChDir MyPath
    FName = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*")
    If FName = False Then
       
    Else
    Clear_Column_A_I
        GetData FName, "du lieu", "b10:i28", Sheets("Sheet1").Range("b10"), False, False
    End If
    ChDrive SaveDriveDir
    ChDir SaveDriveDir
    Sheets("sheet1").Select
    MsgBox "Done !!!", vbExclamation, "Import Data"
End Sub

Sub Clear_Column_A_I()
    Sheets("sheet1").Select
    Range("b10:i70").ClearContents
    [a1].Select
End Sub

Bạn xem thêm file đính kèm nhé.

 

[challenge98]

Cẳm ơn bạn nhưng code của bạn chưa tối ưu vì dữ liệu của mình không cố định là tới dòng 28 mà nó có thể thay đổi có thể lấy toàn bộ dữ liệu mà không cố định hàng và cột cuối không nhỉ? và mình muốn lấy dữ liệu trên cả 2 sheet dữ liệu 1 và 2 vào 2 sheet 1 và 2 trong file tổng hợp có được không nhi?

 

[hiennt218]

Thanks nhé. Bạn nào có hướng dẫn có cả hình ảnh không. Mình ngố quá nên mong các bạn chỉ giùm. Xin đa tạ

 

[phihndhsp]

Option Explicit

Sub Data_Actual()
Dim Cn As Object
Dim rst As Object
Dim ConnString As String
Dim Pro As String
Dim Ext As String
Dim Name As String
Set Cn = CreateObject("ADODB.connection")
Set rst = CreateObject("ADODB.recordset")

     Name = ThisWorkbook.FullName
     Sheet15.Range("A2:E1000000").Clear
     Pro = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source="
     Ext = ";Extended Properties=""Excel 12.0;HDR=yes;IMEX= 1"";"
     Cn.Open (Pro & Name & Ext)
     rst.Open ("select branchnbr,TRIM(scope),TRIM(nhomsp_),orgnbr,SUM(dudauqd)/1000000000 from [DATA$D1:AI50000] GROUP BY branchnbr,TRIM(scope),TRIM(nhomsp_),orgnbr"), Cn
    Sheet15.Range("A2").CopyFromRecordset rst
    rst.Close
    Cn.Close
End Sub

Em có đoạn code đơn giản trên, Bình thường em vẫn kết nối được với hàng trăm nghìn dòng, nhưng không hiểu code file excel bị cái gì mà khi em kết nối data với from [DATA$D1:AI50000] thì ok, nhưng với from [DATA$D1:AI100000] thì bị lỗi không biết đây là lỗi file hay giới hạng flied trong CSDL của excel, Nếu em kết nối với file khác thì số dòng bao nhiêu cũng ok, mà kết nối chính với file đó thì bị lỗi, xin chân thành cảm ơn