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
Revision to Existing Code
-
- Administrator
- Posts: 78596
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Revision to Existing Code
You could test like this
(BTW, Francois is a Belgian male)
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
...
Best wishes,
Hans
Hans
-
- BronzeLounger
- Posts: 1488
- Joined: 05 Feb 2010, 22:25
Re: Revision to Existing Code
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
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
-
- Administrator
- Posts: 78596
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Revision to Existing Code
Without knowing the details of the database and of the report design it's hard to tell what's going on.
Best wishes,
Hans
Hans
-
- BronzeLounger
- Posts: 1488
- Joined: 05 Feb 2010, 22:25
Re: Revision to Existing Code
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
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
You do not have the required permissions to view the files attached to this post.
-
- 3StarLounger
- Posts: 287
- Joined: 09 Mar 2010, 23:16
- Location: Canberra Australia
Re: Revision to Existing Code
You delete all the records from tmpWeeklyVisit but don't put any back before checking whether there are any records in tmpWeeklyvisit.
I think you should be checking rstVP rather than rstWVR.
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
Regards
John
John
-
- BronzeLounger
- Posts: 1488
- Joined: 05 Feb 2010, 22:25
Re: Revision to Existing Code
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
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
-
- Administrator
- Posts: 78596
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Revision to Existing Code
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.
Best wishes,
Hans
Hans
-
- BronzeLounger
- Posts: 1488
- Joined: 05 Feb 2010, 22:25
Re: Revision to Existing Code
>>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
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
-
- Administrator
- Posts: 78596
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Revision to Existing Code
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.
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.
You do not have the required permissions to view the files attached to this post.
Best wishes,
Hans
Hans
-
- BronzeLounger
- Posts: 1488
- Joined: 05 Feb 2010, 22:25
Re: Revision to Existing Code
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
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
-
- BronzeLounger
- Posts: 1488
- Joined: 05 Feb 2010, 22:25
Re: Revision to Existing Code
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
Thanks,
Leesha
-
- Administrator
- Posts: 78596
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Revision to Existing Code
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.
Best wishes,
Hans
Hans