ADODB连接给出未定义的错误

Question

enter image description here我在excel工作簿中设置了一个宏，它将在Access数据库中运行一些查询，并在excel中复制返回的记录。

虽然它到目前为止工作正常，但它今天停止了，在我应该打开连接的行中给出了一个未指明的错误

有趣的是，如果我在一个空的excel工作簿上使用它，宏可以工作 - 但是因为我需要在我设置的初始模板工作簿上需要它，所以不能将它移动到那里（20张完整的公式）< / p>

如果有人知道为什么

，这是我的代码

    Sub Query_CompanyParent(ByVal xQueryName As String, ByVal xParaCompany As String, ByVal xParaParent As String, _
                ByVal xDestnSheet As String, ByVal xDestnRange As String)

Dim cn As Object
    Dim cmd As Object
    Dim rs As Object
    Dim strSql As String
    Dim strConnection As String
    Dim AppPath As String

    Set cn = CreateObject("ADODB.Connection")
    Set cmd = CreateObject("ADODB.Command")
    'AppPath = Application.ActiveWorkbook.Path
    AppPath = "MyPath"

    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & AppPath & "My database;"

    Debug.Print strConnection

    cn.Open strConnection ' this is where the debugger points me


    Const adCmdStoredProc As Long = 4
    Const adParamInput   As Long = 1
    Const adDate As Long = 7
    Const adVarChar As Long = 200


    cmd.CommandText = xQueryName

    With cmd
        .ActiveConnection = cn
        .CommandType = adCmdStoredProc
        .Parameters.Append .CreateParameter("[Company:]", adVarChar, adParamInput, 200, xParaCompany)
        .Parameters.Append .CreateParameter("[Parent:]", adVarChar, adParamInput, 200, xParaParent)
    End With

    Set rs = cmd.Execute()
    Dim Rw As Long, Col As Long, c As Long
    Dim MyField, Location As Range

    ActiveWorkbook.Sheets(xDestnSheet).Select
    ActiveWorkbook.Sheets(xDestnSheet).Activate

   Set Location = ActiveWorkbook.Sheets(xDestnSheet).Range(xDestnRange)
Rw = Location.Row
    Col = Location.Column
    c = Col

      For Each MyField In rs.Fields      'Header of the results
        Cells(Rw, c) = MyField.Name
        c = c + 1
    Next MyField

    Rw = Rw + 1
    c = Col

    Do Until rs.EOF
        For Each MyField In rs.Fields
                Cells(Rw, c) = MyField
                c = c + 1
        Next MyField

        rs.MoveNext
        Rw = Rw + 1
        c = Col
    Loop


    'Set database objects to nothing
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing


    End Sub

由于