ADODB.Recordset EOF No record

[optionone]

Hi,

Trying to build an access database (to be completed by early jan) with a module that looks up patient information from a database - unfortunately my visual basic knowledge is non-existent and although I have a working script (borrowed from another db) if an unknown patient number is entered or something other than a patient number it returns a 3021 runtime error (either BOF or EOF is true, or the current record
has been deleted. requested operation requires a current record).

Code is as follows - from my frantic google searching trying to understand vb better i believe it is do with the line 'If objRs.EOF Then' as objrs wont get to the EOF if there is no record if the patient number is not recognised?? I presume what I need here is something like 'if objrs is null'?

Public Function pmipatient()
  '* Microsoft ActiveX Data Objects Library must be referenced for code to work.
  Dim objcn As ADODB.Connection                                 '* ADO Connection object
  Dim objRs As ADODB.Recordset                                  '* ADO Record set object
  Dim sSQL As String
  Dim sPatientExtraGet As String
  Dim MyReply As String
  Dim Forename1 As String
  Dim Surname As String
  Dim DateOfBirth As String
  Dim NHSNo As String
  Dim PatientID As String
  Dim mdbthis As Database
  Dim mrsPatients As Recordset
 
  Set mdbthis = CurrentDb
  Set mrsPatients = mdbthis.OpenRecordset("temptable-pmi-lookup", dbOpenDynaset)
 
 
  '* Prompt for patient number
  sPatientExtraGet = InputBox("Enter Hospital Number", "Get Patient Details")
  If Len(sPatientExtraGet) = 0 Then
      Dim stDocName As String
    stDocName = "delquery-pmi-data"
    DoCmd.OpenQuery stDocName, acNormal, acEdit
 
  DoCmd.OpenForm "Form1", acNormal
  Exit Function
 
  End If
 
  '** Open connection to SQL Server DB using the required connection properties.
  Set objcn = New ADODB.Connection                              '* Connection Object
  Set objRs = New ADODB.Recordset                               '* Record set object
  objcn.ConnectionString = "Driver={SQL Server};Server=MPIDB;Database=MPI;UseProcForPrepare=2" '*Specify connection properties
  objcn.Open                                                    '* Open connection to DB
  '** Get patient record
  sSQL = "Execute sp_PatientExtraGet'" & sPatientExtraGet & "'"     '*Source System assumed
  Set objRs.ActiveConnection = objcn
  objRs.Open sSQL, objcn, adOpenForwardOnly, adLockReadOnly     '* Open recordset
 
    DateOfBirth = objRs("DateOfBirth")
    Forename1 = objRs("Forename1")
    Surname = objRs("Surname")
    PCTCode = objRs("PCTCode")
    NHSNo = objRs("NHSNo")
    PatientID = objRs("OldID")
 
  If objRs.EOF Then                                             '* Check if record exists
        MsgBox "Patient record not found", vbExclamation            '* No record exists
  Else
        MyReply = MsgBox("Patient is:" & vbCrLf & vbCrLf & "Hospital Number:" & " " & objRs("OldID") & vbCrLf & vbCrLf & "Name:" & " " & objRs("Forename1") & " " & objRs("Surname") & vbCrLf & vbCrLf & "Date of Birth:" & " " & objRs("DateOfBirth") & vbCrLf & vbCrLf & "PCT:" & " " & objRs("PCTCode") & vbCrLf & vbCrLf & "NHS Number:" & " " & objRs("NHSNo") & vbCrLf & vbCrLf & "Import this patient into the database?", vbYesNo)
 
    'SQL insert statement
    If MyReply = vbYes Then
     mrsPatients.AddNew
     mrsPatients("HospNum") = PatientID
     mrsPatients("NHSNum") = NHSNo
     mrsPatients("Forename") = Forename1
     mrsPatients("Surname") = Surname
     mrsPatients("DOB") = DateOfBirth
     mrsPatients("PCT") = PCTCode
     mrsPatients.Update    '*required to update the new record
 
    If MyReply = vbNo Then Exit Function
 
  End If
  End If
objRs.Close                                                   '* Close Record set
objcn.Close                                                   '* Close connection object
 
End Function

Many thanks for any help in fixing/understanding this!

 

[DCrake]

You need to test for EOF before you try and extract data from the objrs

Logic

objrs.Open

If objrs.EOF

Else

End If

 

[optionone]

Sorry - how would i go about testing for EOF? My vb knowledge really is basic

 

[DCrake]

Your code

  objRs.Open sSQL, objcn, adOpenForwardOnly, adLockReadOnly     '* Open recordset
 
    DateOfBirth = objRs("DateOfBirth")
    Forename1 = objRs("Forename1")
    Surname = objRs("Surname")
    PCTCode = objRs("PCTCode")
    NHSNo = objRs("NHSNo")
    PatientID = objRs("OldID")
 
  If objRs.EOF Then                                             '* Check if record exists
        MsgBox "Patient record not found", vbExclamation            '* No record exists
  Else

Change to

  objRs.Open sSQL, objcn, adOpenForwardOnly, adLockReadOnly     '* Open recordset
   If objRs.EOF Then                                             '* Check if record exists
        MsgBox "Patient record not found", vbExclamation            '* No record exists
  Else

    DateOfBirth = objRs("DateOfBirth")
    Forename1 = objRs("Forename1")
    Surname = objRs("Surname")
    PCTCode = objRs("PCTCode")
    NHSNo = objRs("NHSNo")
    PatientID = objRs("OldID")
 
.....

 

[optionone]

Many thanks for the help - that was loads simpler than i thought it would be