运行下面的代码：自动化错误，对象库没有注册，高手赐教

zangma

'http://www.excelpx.com  EXCEL精英培训网范例
'作者 LDY ，转载请保留
'功能 实现多文件，多表汇总、合并
'引用 Microsoft ADO Ext. 2.8 for DDL and Security
'引用 Microsoft ActiveX Data Objects 2.8 Library
'引用 Microsoft Scripting Runtime

Sub addExcel()
    Dim d As New Dictionary, arr(), i As Long
    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim cog As New Catalog
    Dim Sql As String
    Dim myDatePath As String
    Dim ThisExcelName As String
    Dim Dirs As String
    On Error GoTo ErrMsg
    Cells = Empty
    ThisExcelName = ThisWorkbook.Name

    Dirs = Dir(ThisWorkbook.Path & "\*.xls")
    If ThisExcelName <> Dirs Then
        myDatePath = ThisWorkbook.Path & "\" & Dirs
        d(myDatePath) = 0
    End If


    Do While Dirs <> ""
        Dirs = Dir
        If ThisExcelName <> Dirs And Dirs <> "" Then
            myDatePath = ThisWorkbook.Path & "\" & Dirs
            d(myDatePath) = 0
        End If
    Loop
    If d.Count = 0 Then MsgBox "没找到数据文件": Exit Sub
   
    arr = d.Keys
    d.RemoveAll

    For i = 0 To UBound(arr)
        Sql = "Provider=Microsoft.Jet.OleDb.4.0;Extended Properties=Excel 8.0;Data Source=" & arr(i)
        cnn.Open Sql
        Set cog.ActiveConnection = cnn
        For Each Tabs In cog.Tables
            Sql = "Select * From [Excel 8.0;DATABASE=" & arr(i) & "].[" & Tabs.Name & "]"
            d(Sql) = 0
        Next
        cnn.Close
    Next

    Sql = Join(d.Keys, " UNION ALL ") & " order by 姓名"
    If MsgBox("汇总请选“是”，合并请选“否”", 4) = vbYes Then
        Sql = "SELECT  姓名, Sum(计件) AS 产量, Count(姓名) AS 工作次数 from (" & Sql & ") GROUP BY 姓名"
    End If
    cnn.Open "Provider=Microsoft.Jet.OleDb.4.0;Extended Properties=Excel 8.0;Data Source=" & myDatePath
    Set rst = cnn.Execute(Sql)


    Range("e1") = "总表数 : " & d.Count
    Range("a2").CopyFromRecordset rst
    For i = 1 To rst.Fields.Count
        Cells(1, i) = rst(i - 1).Name
    Next
    MsgBox "Excel表格汇总成功！", , "表格汇总"
    Exit Sub
ErrMsg:
    MsgBox Err.Description, , "错误报告"
End Sub



运行上面的代码是说自动化错误，对象库没有注册
该引用的都引用了
高手赐教
附件是要汇总工作薄里的一个工作薄

[ 本帖最后由 zangma 于 2008-12-27 20:29 编辑 ]