rst.update not working

[Tarnon]

Hi there tried creating new entry, it only works when the database is decompreste? weird I know.

can anyone help ?

thanks

PS: see code below

Dim HospitalNumber As String
Dim strSQL0 As String
dim LastName As String
Dim FirstName As String
Dim strDOB As String
 
If IsNull(Me.Text0.Value) Then
strHospitalNumber = " Like '*' "
Else
strHospitalNumber = "='" & Me.Text0.Value & "' "
End If
 
If IsNull(Me.Combo8.Value) Then
strLastName = " Like '*' "
Else
strLastName = "='" & Me.Combo8.Value & "' "
End If
 
If IsNull(Me.Combo10.Value) Then
strFirstName = " Like '*' "
Else
strFirstName = "='" & Me.Combo10.Value & "' "
End If
 
If IsNull(Me.DOB.Value) Then
strDOB = " Like '*' "
Else
strDOB = "=" & "#" & Format(Me![DOB], "mm\/dd\/yyyy") & "# "
End If
 
 
strSQL0 = "SELECT Profile.* " & _
         "FROM Profile " & _
         "WHERE Profile.HospitalNumber" & strHospitalNumber & _
         "AND Profile.LastName" & strLastName & _
         "AND Profile.FirstName" & strFirstName & _
         "AND Profile.DOB" & strDOB & _
         "ORDER BY Profile.PtID;"
 
Set rst1 = CurrentDb.OpenRecordset(strSQL0)
 
If rst1.EOF Then
 
Dim Msg, Style, Title, Response
 
Msg = "There are no existing records for this patient in the database. To add this patient, click 'Yes'. To cancel and close this message box, click 'no'."
Style = vbYesNo + vbDefaultButton2
Title = "Would you like to add this patient to the database?"
Response = MsgBox(Msg, Style, Title)
 
If Response = vbYes Then
 
rst1.Close
 
DoCmd.SetWarnings (WarningsOff)
 
  Set rst2 = CurrentDb.OpenRecordset("Profile")
 
  rst2.AddNew
      rst2![HospitalNumber] = Me![Text0] 'the field from your form that matches the table column
      rst2![LastName] = Me![Combo8]
      rst2![FirstName] = Me![Combo10]
      rst2![DOB] = Me![DOB]
 
rst2.Update
 
Dim strSQL1 As String
Dim rptID1 As String
 
strSQL1 = "Select Max([PtID]) as [MaxOfID] from Profile;"
 
  Set rst3 = CurrentDb.OpenRecordset(strSQL1)
  rst3.MoveFirst
 
  rptID1 = rst3![MaxOfID]
 
DoCmd.SetWarnings (WarningsOn)
 
DoCmd.OpenForm "Profile", acNormal, , "[PtID]= " & rptID1, acFormEdit, acWindowNormal
 
rst2.Close
rst3.Close
 
DoCmd.Close acForm, "FindPatient", acSaveYes
 
Else
'Do Nothing
 
End If
 
 
ElseIf rst1.RecordCount = 1 Then
 
Dim strSQL2 As String
 
strSQL2 = "SELECT Profile.PtID As PatientID " & _
         "FROM Profile " & _
         "WHERE Profile.HospitalNumber" & strHospitalNumber & _
         "AND Profile.LastName" & strLastName & _
         "AND Profile.FirstName" & strFirstName & _
         "AND Profile.DOB" & strDOB & _
         "ORDER BY Profile.PtID;"
 
Set rst4 = CurrentDb.OpenRecordset(strSQL2)
 
rst4.MoveFirst
 
Dim RptID2 As String
 
RptID2 = rst4![PatientID]
 
DoCmd.OpenForm "Profile", acNormal, , "[PtID]= " & RptID2, acFormEdit, acWindowNormal
 
DoCmd.Close acForm, "FindPatient", acSaveYes
 
rst1.Close
rst4.Close
 
 
Else
 
Dim Msg2, Style2, Title2, Response2
 
Msg2 = "There are more than 1 records matching these criteria. If you would like to browse these, click 'Yes'. If you would like to enter more criteria, click 'No'."
Style2 = vbYesNo + vbDefaultButton2
Title2 = "Would you like to browse all matching records?"
Response2 = MsgBox(Msg2, Style2, Title2)
 
If Response2 = vbYes Then
 
DoCmd.OpenForm "Profile", acNormal, strSQL0, acFormEdit
'corresponding to rst1
 
DoCmd.Close acForm, "FindPatient", acSaveYes
 
Else
'Do Nothing
 
End If
 
rst1.Close
 
End If
 
 
End Sub