[AccessD] Function Error

Gowey Mike W Mike.W.Gowey at doc.state.or.us
Fri Jan 27 08:54:22 CST 2006


I'm converting a database from 97 to 2000 and have run into a problem
with the below function.  Could someone please tell me why the
highlighted part is failing?  I get a " Runtime error '5' Invalid
procedure call "


Public Function UpdateSID4Bin() As Boolean
  
  Dim oDB As Database
  Dim oRS As Recordset
  Dim oRSBins As Recordset
  Dim sSql As String
  Dim j As Long
  Dim vRtn As Variant
  
  UpdateSID4Bin = False
  
  Set oDB = CurrentDb
  
  DoCmd.Hourglass True
  
  ' display message in status bar
  vRtn = SysCmd(acSysCmdInitMeter, "Updating Bin Number System With New
SIDs...", 10)
  
  For j = 0 To 9
    ' update meter
    vRtn = SysCmd(acSysCmdUpdateMeter, j + 1)
    DoEvents
    
    ' get all SIDs that are not assigned a bin number for the current
row
    sSql = "SELECT SID FROM qryInmatesBinNumberUpdate WHERE Row = '" & j
& "' ORDER BY Row"
    Set oRS = oDB.OpenRecordset(sSql)
    
    Do While Not oRS.EOF
      ' grab an empty bin for the current row
      sSql = "SELECT TOP 1 BinNum FROM BinNumSIDAssign WHERE Row = '" &
j & "' AND SID IS NULL"
      Set oRSBins = oDB.OpenRecordset(sSql)
      
      If Not oRSBins.EOF Then
        ' update empty bin with current SID
        sSql = "UPDATE BinNumSIDAssign SET SID = '" & oRS.Fields("SID")
& "' WHERE Row = '" & j & "' AND BinNum = '" & oRSBins.Fields("BinNum")
& "'"
        oDB.Execute sSql
      End If
      
      ' get next SID
      oRS.MoveNext
      
    Loop
  Next
  
  UpdateSID4Bin = True
  
ExitFunction:
  On Error Resume Next
  
  oRS.Close
  oRSBins.Close
  oDB.Close
  
  Set oRS = Nothing
  Set oRSBins = Nothing
  Set oDB = Nothing
  
  DoCmd.Hourglass False
  vRtn = SysCmd(acSysCmdRemoveMeter)
  
End Function

Public Function CheckEvent(pEvent As String) As Boolean
  
  Dim oDB As DAO.Database
  Dim oRS As DAO.Recordset
  Dim sSql As String
  
  CheckEvent = False
  
  Set oDB = CurrentDb
  
  sSql = "SELECT Complete FROM DownloadEvents " & vbCrLf
  sSql = sSql & "WHERE EventName = '" & pEvent & "'"
  Set oRS = oDB.OpenRecordset(sSql)
  
  With oRS
    If Not .EOF Then
      CheckEvent = (.Fields(0) = True)
    End If
  End With
  
ExitFunction:
  On Error Resume Next
  
  oRS.Close
  oDB.Close
  
  Set oRS = Nothing
  Set oDB = Nothing
  
End Function

Public Sub InitDownloadEvents()
  
  Dim oDB As DAO.Database
  Dim sSql As String
  
  ' init events
  Set oDB = CurrentDb
  sSql = "UPDATE DownloadEvents SET Complete = False"
  oDB.Execute sSql
  
  oDB.Close
  Set oDB = Nothing
  
End Sub

Public Function SetEvent(pEvent As String) As Boolean
  
  Dim oDB As DAO.Database
  Dim sSql As String
  
  SetEvent = False
  
  Set oDB = CurrentDb
  
  sSql = "UPDATE DownloadEvents SET Complete = TRUE " & vbCrLf
  sSql = sSql & "WHERE EventName = '" & pEvent & "'"
  oDB.Execute sSql
  
  SetEvent = True
  
ExitFunction:
  On Error Resume Next
  
  oDB.Close
  Set oDB = Nothing
  
End Function


Thanks in advance for any help provided.


Mike Gowey  MCP, MCDST, A+, LME, NET+
Team Leader - SouthEast Region
Information Systems Unit




More information about the AccessD mailing list