Sử Dụng Hàm GetData của Tác giả Ndu (1 người xem)

[vanvan9697]

Em có sử dụng Hàm Getdata của Tác giả NDu để lấy dữ liệu Tuy nhiên hàm này em làm trên bộ Office 2016 thì không bị lỗi. Tuy Nhiên khi em làm trên office 2010 bị lỗi dòng này. Anh (Chị ) xem giúp em với ạ !
rsCon.Open szConnect

 Function GetData(ByVal FileName As String, ByVal SheetName As String, ByVal RangeAddress As String, _
            ByVal HasTitle As Boolean, ByVal UseTitle As Boolean)
    Dim rsCon As Object, rsData As Object, cat As Object, tbl As Object
    Dim tmpArr, Arr()
    Dim szConnect As String, szSQL As String, Tmp As String
    Dim lCount As Long, lR As Long, lC As Long, lVer As Long
    lVer = Val(Application.Version)
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")
    Set cat = CreateObject("ADOX.Catalog")
    If lVer < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 8.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & FileName & ";" & _
                "Extended Properties=""Excel 12.0;HDR=" & IIf(HasTitle, "Yes", "No") & """;"
    End If
    If SheetName = "" Then
    Dim Dbs  As Object, db As Object
        Set Dbs = CreateObject("DAO.DBEngine." & IIf(lVer < 12, "36", "120"))
        Set db = Dbs.OpenDatabase(FileName, False, False, "Excel 8.0;")
        Tmp = db.TableDefs(0).Name
        Tmp = Replace(Tmp, " ", "?")
        Tmp = Replace(Tmp, "'", " ")
        Tmp = WorksheetFunction.Trim(Tmp)
        Tmp = Replace(Tmp, " ", "'")
        Tmp = Replace(Tmp, "?", " ")
        SheetName = Tmp
        db.Close
        Set Dbs = Nothing: Set db = Nothing
    End If
    If Right(SheetName, 1) <> "$" Then SheetName = SheetName & "$"
    rsCon.Open szConnect
    cat.ActiveConnection = rsCon
    szSQL = "SELECT * FROM [" & SheetName & RangeAddress & "];"
    rsData.Open szSQL, rsCon, 0, 1, 1
    tmpArr = rsData.GetRows
    ReDim Arr(UBound(tmpArr, 2) - UseTitle, UBound(tmpArr, 1) + 1)
    If UseTitle Then
        For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
            Arr(0, lC) = rsData.Fields(lC).Name
        Next
    End If
    For lR = LBound(tmpArr, 2) To UBound(tmpArr, 2)
        For lC = LBound(tmpArr, 1) To UBound(tmpArr, 1)
            Arr(lR - UseTitle, lC) = tmpArr(lC, lR)
        Next
    Next
    rsData.Close: Set rsData = Nothing
    rsCon.Close: Set rsCon = Nothing
    GetData = Arr
End Function