ADODB记录集打开返回错误＃：13

Question

I've been using stackoverflow for over a year now but this is my first post so if I do something wrong, please let me know and I'll try to do better next time.

I'm currently using MS Access 2003 as a front-end data entry application with an MS SQL 2008 back end. A function used by just about every form in the app is breaking for no reason that I can determine when called from a specific subroutine.

Calling subroutine:

Private Sub Form_Load()

strRep = GetAppCtl("ConUID")

FLCnnStr = GetAppCtl("ConStrApp")

strSQL2 = "SELECT EMPNMBR, First, Last, TSLogin, IsITAdmin, " & _
           " IsManager, Pwd, AppAuthLvl, SEX, AppTimeOutMins " & _
            " FROM utEmplList WHERE EMPNMBR = " & _
            strRep & ";"

Set cnn = New ADODB.Connection
With cnn
    .ConnectionString = FLCnnStr
    .Open
End With

Set rst = New ADODB.Recordset
rst.Open strSQL2, cnn, adOpenDynamic, adLockReadOnly

intAppAuthLvl = rst!AppAuthLvl

' Loaded/opened with parameters / arguments (OpenArgs)?
If Not IsNull(Me.OpenArgs) And Me.OpenArgs <> "" Then
    Me.txtEmpSecLvl = Me.OpenArgs
Else
    Me.txtEmpSecLvl = "99999<PROGRAMMER>Login:-1,-1\PWD/999|M!60$"
End If

Me.lblDateTime.Caption = Format(Now, "dddd, mmm d yyyy hh:mm AMPM")

If FirstTime <> "N" Then

    ' Set default SQL select statement with dummy WHERE clause
    '   (DealID will always be <> 0!)

    strDate = DateAdd("d", -14, Now())

    strSQLdefault1 = "SELECT *, DealHasTags([PHONE10],[REP]) as DealHasTags FROM utDealSheet WHERE DealID <> 0 AND (STATUS BETWEEN '00' AND '99') "
    strSQLdefault2 = "SELECT *, DealHasTags([PHONE10],[REP]) as DealHasTags FROM utDealSheet WHERE DATE >= #" & strDate & "# AND DealID <> 0 AND (STATUS BETWEEN '00' AND '99') "

    Me.LoggingDetail.Enabled = False
    Me.LoggingDetail.Visible = False

    If rst!AppAuthLvl <= 200 Then
        strSQL = strSQLdefault1 & ";"
        Me.LoggingDetail.Form.RecordSource = strSQL
    Else
        strSQL = strSQLdefault2 & ";"
        Me.LoggingDetail.Form.RecordSource = strSQL
    End If

    FirstTime = "N"

End If

DoCmd.Maximize

End Sub

Function that is breaking:

Public Function GetAppCtl(strFldDta As String) As Variant

Dim strSQL As String
Dim cnn As ADODB.Connection
Dim rst  As ADODB.Recordset
Dim strConnString As String

If IsNull(strFldDta) Then GetAppCtl = "ERR"

' Starting string
strConnString = "ODBC;Description=SQLUmgAgr;DRIVER=SQL Server;SERVER="

' Set a connection object to the current Db (project)
Set cnn = CurrentProject.Connection

strSQL = "Select ConStrApp, ConStrTS, DftOfficeID, RecID, VerRelBld, SeqPrefix, ConDb, ConDbTs, ConUID, ConUIDTS, ConPWD, ConPWDTs, ConServer, ConServerTS, ConWSID, ConWSIDTS from tblAppCtl WHERE RecID = 1;"

Set rst = New ADODB.Recordset
rst.Open strSQL, cnn, adOpenKeyset, adLockReadOnly

' If a Db error, return 0
If Err.Number <> 0 Then
    GetAppCtl = ""
    GoTo CleanUp
End If

' If no record found, return 0
If rst.EOF Then
    GetAppCtl = ""
Else        ' Otherwise, return Version/Build

    Select Case strFldDta

        Case Is = "ConStrApp"               ' connection string - application

            strConnString = strConnString & Trim(rst!Conserver) & ";" _
                    & "UID=" & Trim(rst!ConUID) & ";PWD=" & Trim(rst!conpwd) & ";" _
                    & "DATABASE=" & Trim(rst!ConDb) & ";WSID=" & Trim(rst!ConWSID)

            GetAppCtl = strConnString

        Case Is = "ConStrTS"             ' connection string - TouchStar

            strConnString = strConnString & Trim(rst!ConserverTS) & ";" _
                    & "UID=" & Trim(rst!ConUIDTS) & ";PWD=" & Trim(rst!conpwdTS) & ";" _
                    & "DATABASE=" & Trim(rst!ConDbTS) & ";WSID=" & Trim(rst!ConWSID)

            GetAppCtl = strConnString

        Case Is = "DftOfficeID"             ' Default AGR office ID

            GetAppCtl = rst!DftOfficeID

        Case Is = "VerRelBld"               ' Current APP ver/rel/bld (to be checked against SQL Db
            GetAppCtl = rst!VerRelBld

        Case Is = "SeqPreFix"               ' Sales seq# prefix (ID as per office for backward capability)
            GetAppCtl = rst!SeqPrefix

        Case Is = "ConUID"
            GetAppCtl = rst!ConUID
    End Select

End If

CleanUp:

    rst.Close
    Set rst = Nothing
    cnn.Close
    Set cnn = Nothing

End Function

The function is breaking here, but only when called by the above sub:

Set rst = New ADODB.Recordset
rst.Open strSQL, cnn, adOpenKeyset, adLockReadOnly

' If a Db error, return 0
If Err.Number <> 0 Then
    GetAppCtl = ""
    GoTo CleanUp
End If

When called from any other sub it works fine and returns the appropriate value. Please help.

Answer 1

I don't have an actual explanation as to why it was returning an error code but by removing the error checking the process worked. If anyone has an actual explanation as to what was actually causing the issue it would be greatly appreciated.

Answer 2

I know this post's a bit old and OP might have solved the problem. I encountered the same problem and solved it by changing "Microsoft ActiveX Data Objects 2.5 Library" to "Microsoft ActiveX Data Objects 2.8 Library" from VBA Tools => References.