Revision to Existing Code

[Leesha]

Hi!

Francoise (sp) gave me this wonderful code years ago and it works beautifully. We have a new smaller office that uses it and is running into a problem when there is nothing in the tmpWeeklyVisit table. The report blows up. I'd like to insert a conditional statement (and have tried without success) that says if there is no data in tmpWeeklyVisit, the code is stopped and a message box comes up stating there are no pending shifts. Presently its blowing up on the code that is red below when there is no data in the table. Thanks!!! Leesha

Private Sub Report_Open(Cancel As Integer)
Dim DB As DAO.Database
Dim rstVP As DAO.Recordset
Dim rstWVR As DAO.Recordset
Dim strSQL As String
strSQL = "Delete * From tmpWeeklyVisit"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True
Set DB = CurrentDb
strSQL = "Select cl_last, cl_first, Skill, StartTime,EndTime, dayofwk " & _
" From tblPendingList " & _
"WHERE InStr('n',[visit_stat])<>0 "

Set rstVP = DB.OpenRecordset(strSQL)
Set rstWVR = DB.OpenRecordset("tmpWeeklyVisit", dbOpenDynaset)
rstVP.MoveLastrstVP.MoveFirst
Do While Not rstVP.EOF
rstWVR.FindFirst "[starttime] = #" & rstVP!StartTime & "#"
If rstWVR.NoMatch Then
rstWVR.AddNew
rstWVR!StartTime = rstVP!StartTime
Else
rstWVR.Edit
End If



rstWVR(rstVP!dayofwk) = rstWVR(rstVP!dayofwk) & rstVP!cl_last & ", " & rstVP!cl_first & " - " & _
rstVP!skill & vbCrLf & Format(rstVP!StartTime, "hh:nn AM/PM") & " To " & _
Format(rstVP!EndTime, "hh:nn AM/PM") & vbCrLf & vbCrLf




rstWVR.Update
rstVP.MoveNext
Loop
Set rstWVR = Nothing
Set rstVP = Nothing
Set DB = Nothing

End Sub

[HansV]

You could test like this

Code: Select all

    Set rstWVR = DB.OpenRecordset("tmpWeeklyVisit", dbOpenDynaset)
    If rstWVR.EOF Then
        ' There are no records
        MsgBox "Alas! We have run out of records today! Please come back another time.", vbInformation
        rstWVR.Close
        Exit Sub
    End If
    rstWVR.MoveLast
    rstWVR.MoveFirst
    ...

(BTW, Francois is a Belgian male)

[Leesha]

Hi Hans!
I'm killing myself laughing with your Msgbox message as well as the comment re my spelling of Francois's name. Made my day!

I inserted your code but get the "Alas" message whether there is info or not. The code is on the report_open event. I'm not sure is that makes a difference or not. Also, after I hit OK to get rid of the message I get an error in the red area of the following code (which I didn't even recall being in this report). The error is that I entered an expression that has no value. The area that it points to is in red.

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
Dim strClient() As String
Dim strModified As String
Dim intDay As Integer
Dim strField As String

If FormatCount = 1 Then
For intDay = 1 To 7
' pick the field name you're dealing with
strField = Choose(intDay, "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
' split the values in the field into an array
strClient = Split(Nz(Me(strField)), ";") ' rebuild the string with CRLF instead of semicolon
strModified = Join(strClient, vbCrLf)
' assign the new string to the control for the field
Me("txt" & strField) = strModified
Next intDay
End If
End Sub

[HansV]

Without knowing the details of the database and of the report design it's hard to tell what's going on.

[Leesha]

Hi Hans,

I'm updating a stripped down version of the database. The date range to put in would be 11/6/2010 to 11/12/2010. The office with Data is Norwich. Old Lyme and Willimantic have no data. Old Lyme and Willimantic should open to the msg box statement of "Alas..........". Norwich should open to show the pending shift in the report.

Thanks,
Leesha

[JohnH]

You delete all the records from tmpWeeklyVisit but don't put any back before checking whether there are any records in tmpWeeklyvisit.

Code: Select all

strSQL = "Delete * From tmpWeeklyVisit"

DoCmd.RunSQL strSQL
Set rstWVR = DB.OpenRecordset("tmpWeeklyVisit", dbOpenDynaset)
If rstWVR.EOF Then
        ' There are no records
        MsgBox "Alas! We have run out of records today! Please come back another time.", vbInformation

I think you should be checking rstVP rather than rstWVR.

[Leesha]

Hi John,
There are records that are put back into tmpWeeklyVisit but I didn't send that portion of the code etc. due the file being too large and the fact that the code for that piece is linked to sql tables. I only uploaded the portion after the table has been populated.

Leesha

[HansV]

You delete all records from the table tmpWeeklyVisit, then open a recordset on it (rstWVR). The recordset will then be empty, of course, so you display the "Alas..." message box and exit. The code that adds records to tmpWeeklyVisit comes after this, but it is never executed because you have already exited the code.

[Leesha]

>>You delete all records from the table tmpWeeklyVisit, then open a recordset on it (rstWVR). The recordset will then be empty, of course, so you display the "Alas..." message box and exit. The code that adds records to tmpWeeklyVisit comes after this, but it is never executed because you have already exited the code.

I think I'm following this. However I'm not sure where to place the new code that will alert that there are no records, before the report finishes loading and ultimately blows up. I tried it in a few spots further down in the code but its not working. Is this even possible?

Thanks,
Leesha

[HansV]

One of the reasons you didn't get anything was that the office was spelled 'Noriwch' in the pending list table...

In the attached version, I have simplified the code and moved it to the form, so that the report isn't even opened if there are no records.

Copy of RSMDashboard.zip

[Leesha]

HI!

I found a workaround and wanted to let you know so you didn't waste time on this. Since tmpWeeklyVisit is actually populated from tblPendingList, I used the following code to see if tblPendingList had any records in it. If there are no records, then the report does not open and thus the rest of the code doesn't run.

If IsNull(DLookup("client_no", "tblPendingList")) Then
MsgBox "There are no pending shifts for this office."
Exit Sub
Else:

DoCmd.OpenReport "rptPendingList", acViewPreview
End If

If "seems" to be working!
Thanks,
Leesha

[Leesha]

OMG, it wasn't till I posted this that I saw your response. I hadn't gotten an email that there was a new post and I hadn't refreshed the page. I can't wait to see what you came up with!

Thanks,
Leesha

[HansV]

Checking whether tblPendingList has records at all won't help - you still don't know whether there are records for the selected office and time period.