Question

我一直在使用stackoverflow超过一年，但这是我的第一篇文章，所以如果我做错了，请告诉我，下次我会尽力做得更好。

我目前正在使用MS Access 2003作为带有MS SQL 2008后端的前端数据输入应用程序。应用程序中几乎每个表单都使用的函数无论如何我都可以确定从特定子例程调用的时间。

调用子程序：

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

正在破坏的功能：

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

这个函数在这里打破了，但只有在上面的子句调用时才会打破：

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

当从任何其他子调用时，它工作正常并返回适当的值。请帮忙。

Answer 1

我没有实际的解释，为什么它返回错误代码，但通过删除错误检查过程工作。如果有人对实际导致问题的内容有实际解释，我们将不胜感激。

Answer 2

我知道这篇文章有点陈旧，OP可能已经解决了这个问题。我遇到了同样的问题并通过更改＆＃34; Microsoft ActiveX Data Objects 2.5 Library＆＃34;到＆＃34;微软ActiveX数据对象2.8库＆＃34;来自VBA Tools =＆gt;引用。

ADODB Recordset Open返回错误＃：13

2 个答案: