By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
459,747 Members | 1,533 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 459,747 IT Pros & Developers. It's quick & easy.

If statements not giving desired results for resources database

P: 5
Hi,
I've got a database (Access 2010, Windows 7) that reserves and issues resources. The problem arises for the macro that codes the reservations for the loan items. I can get the macro to display multiple reservations of the same resource (provided they are all on the same day). However, the price I pay for this is that if I make a reservation for today, while setting the return on a later date, the macro will not permit me to set the time in before the time out. While this makes sense for reservations on the same day, it doesn't necessarily for reservations that should be returned on another day.

This limitation is set through some if statements to test that the 'DueDate' is not before the 'Reservation From date', and that the Time the resources are checked in is not before the time they are checked out:

Expand|Select|Wrap|Line Numbers
  1. If Me.DueDate < Me.DateCheckedOut Then
  2.     MsgBox "Due Date cannot be before the Reservation   From date", vbOKOnly + vbExclamation, "Date Error"
  3.     Cancel = True
  4.     Exit Function
  5. End If
  6.  
  7. If Format(Me.TimeIn, "Short Time") < Format(Me.TimeOut, "Short Time") Then
  8.    MsgBox "Time In cannot be before Time Out. Please amend times.", vbOKOnly + vbExclamation, "Time Error"
  9.    Cancel = True
  10.    Exit Function
  11. End If
Provided the reservations do not transcend more than one day, the code works.

If the return date is the next day, the macros will not permit the return time before the issue time. This is clearly a problem.

I was partly able to get around this problem with a third block of code:

Expand|Select|Wrap|Line Numbers
  1. If Me.DueDate = Me.DateCheckedOut And Format(Me.TimeIn, "Short Time") < Format(Me.TimeOut, "Short Time") Then
  2.     MsgBox "Time In cannot be before Time Out. Please  amend times.", vbOKOnly + vbExclamation, "Time Error"
  3.     Cancel = True
  4.     Exit Function
  5.     End If
When I run this third block of code for an item being returned on a later day, I am able to get it to permit the time in before the time out. However, it will message "date clash" if I try to make more than one reservation on the same day, regardless whether the time in of the first reservation is before the time out of the next.

I have included the full code for the Reserve Form Macro below. I would really appreciate it if someone with more experience than I might be able to spot any glaring mistakes in the logic.

Many thanks,
BitesBoy

Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2.  
  3. Private Sub Form_Current()
  4.  
  5. varDuration = DLookup("DefaultLoanDuration", "Equipment", "EquipmentID = '" & Nz(Me.EquipmentID, "") & "'")
  6. Me.txtDuration = varDuration
  7.  
  8. End Sub
  9.  
  10. Public Function CheckValidReservationOld(Cancel As Integer)
  11.  
  12. Dim db As DAO.Database, rs As DAO.Recordset
  13. Dim intnewrec As Integer
  14.  
  15. Set db = CurrentDb()
  16. Set rs = db.OpenRecordset("SELECT EquipmentID, DateCheckedOut, DueDate, IsReservation FROM Loan WHERE EquipmentID='" & Me.EquipmentID & "' AND (IsReservation=True OR DateCheckedIn Is Null) ORDER BY DateCheckedOut ASC")
  17.  
  18. If Me.DueDate < Me.DateCheckedOut Then
  19.     MsgBox "Due Date cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Warning"
  20.     Cancel = True
  21.     Exit Function
  22. End If
  23.  
  24. If rs.RecordCount > 0 And rs.RecordCount <> -1 Then
  25.     MsgBox "Reservations or loans exist", vbOKOnly
  26.     'Item already has one or more reservations
  27.     'Need to check if the new reservation clashes with any existing reservations or bookings
  28.     rs.MoveFirst
  29.     Do While Not rs.EOF
  30.         If (Me.DateCheckedOut >= rs!DateCheckedOut And Me.DueDate <= rs!DueDate) Then
  31.             MsgBox "Dates clash with an existing booking/reservation", vbOKOnly, "Reservation Exists"
  32.             Cancel = True
  33.             Me.DateCheckedOut.SetFocus
  34.             Exit Function
  35.         Else
  36.             'Continue to save record and close window
  37.             DoCmd.RunCommand acCmdSaveRecord
  38.             DoCmd.Close
  39.         End If
  40.     Loop
  41. Else
  42.     'No reservations exist
  43.     'Continue to save record and close window
  44.     DoCmd.RunCommand acCmdSaveRecord
  45.     DoCmd.Close
  46. End If
  47.  
  48. End Function
  49.  
  50.  
  51. 'Public Function CheckValidReservation(Cancel As Integer)
  52. '
  53. 'Dim db As DAO.Database, rs As DAO.Recordset
  54. 'Dim intnewrec As Integer
  55. '
  56. 'Set db = CurrentDb()
  57. '
  58. 'If Me.DueDate < Me.DateCheckedOut Then
  59. '    MsgBox "Due Date cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Date Error"
  60. '    Cancel = True
  61. '    Exit Function
  62. 'End If
  63. '
  64. 'Set rs = db.OpenRecordset("SELECT EquipmentID, DateCheckedOut, DueDate, IsReservation FROM Loan WHERE EquipmentID='" & Me.EquipmentID & "' AND (IsReservation=True OR DateCheckedIn Is Null) AND (DateCheckedOut>=Date()) ORDER BY DateCheckedOut ASC")
  65. '
  66. 'StartDate = Me.DateCheckedOut
  67. 'EndDate = Me.DueDate
  68. '
  69. 'test = False
  70. '
  71. 'If rs.RecordCount = 0 Then
  72. '    'Currently no existing bookings or reservations
  73. '    'Ok to save record and close
  74. '    DoCmd.RunCommand acCmdSaveRecord
  75. '    DoCmd.Close
  76. '    Exit Function
  77. 'End If
  78. '
  79. 'rs.MoveFirst
  80. '
  81. 'Do Until rs.EOF
  82. '
  83. 'If StartDate = rs!DateCheckedOut Or EndDate = rs!DueDate Then
  84. '    test = True
  85. 'ElseIf StartDate >= rs!DateCheckedOut And StartDate <= rs!DueDate Then
  86. '    test = True
  87. 'ElseIf EndDate <= rs!DueDate And EndDate >= rs!DateCheckedOut Then
  88. '    test = True
  89. 'End If
  90. '
  91. 'If test Then
  92. '    rs.MoveLast
  93. '    rs.MoveNext
  94. 'Else
  95. '    rs.MoveNext
  96. 'End If
  97. '
  98. 'Loop
  99. '
  100. 'rs.Close
  101. '
  102. 'If test = False Then
  103. '    'Dates selected are ok
  104. '    'Continue to save record and close window
  105. '    DoCmd.RunCommand acCmdSaveRecord
  106. '    MsgBox "Reservation Saved", vbOKOnly + vbInformation, "Reservation Saved"
  107. '    DoCmd.Close
  108. 'Else
  109. '    'Display error message to user
  110. '    MsgBox "The dates you have selected clash with an existing booking/reservation. Please choose different dates.", vbOKOnly + vbExclamation, "Reservation Clash"
  111. '    'Cancel
  112. '    Cancel = True
  113. '    Me.DateCheckedOut.SetFocus
  114. '
  115. '    Set rs = Nothing
  116. '    Set db = Nothing
  117. '
  118. '    Exit Function
  119. 'End If
  120. '
  121. 'Set rs = Nothing
  122. 'Set db = Nothing
  123. '
  124. 'End Function
  125.  
  126. Public Function CheckValidReservation(Cancel As Integer)
  127.  
  128. Dim db As DAO.Database, rs As DAO.Recordset
  129. Dim intnewrec As Integer
  130.  
  131. Set db = CurrentDb()
  132.  
  133. 'If Me.DueDate < Me.DateCheckedOut Then
  134.     'MsgBox "Due Date cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Date Error"
  135.     'Cancel = True
  136.     'Exit Function
  137. 'End If
  138.  
  139. 'If Format(Me.TimeIn, "Short Time") < Format(Me.TimeOut, "Short Time") Then
  140. '   MsgBox "Time In cannot be before Time Out. Please amend times.", vbOKOnly + vbExclamation, "Time Error"
  141. '   Cancel = True
  142. '   Exit Function
  143. 'End If
  144.  
  145. 'If Me.DueDate = Me.DateCheckedOut And Format(Me.TimeIn, "Short Time") < Format(Me.TimeOut, "Short Time") Then
  146. '    MsgBox "Time In cannot be before Time Out. Please amend times.", vbOKOnly + vbExclamation, "Time Error"
  147. '    Cancel = True
  148. '    Exit Function
  149. 'End If
  150.  
  151. If Me.DueDate = Me.DateCheckedOut Then
  152.    If Format(Me.TimeIn, "Short Time") < Format(Me.TimeOut, "Short Time") Then
  153.     MsgBox "Time In cannot be before Time Out. Please amend times.", vbOKOnly + vbExclamation, "Time Error"
  154.     Cancel = True
  155.     Exit Function
  156.     End If
  157. End If
  158.  
  159. Set rs = db.OpenRecordset("SELECT EquipmentID, DateCheckedOut, DueDate, TimeOut, TimeIn, IsReservation FROM Loan WHERE EquipmentID='" & Me.EquipmentID & "' AND (IsReservation=True OR DateCheckedIn Is Null) AND (DateCheckedOut>=Date()) ORDER BY DateCheckedOut ASC")
  160.  
  161. StartDate = Me.DateCheckedOut
  162. EndDate = Me.DueDate
  163. TimeOut = Format(Me.TimeOut, "Short Time")
  164. TimeIn = Format(Me.TimeIn, "Short Time")
  165.  
  166. test = False
  167.  
  168. If rs.RecordCount = 0 Then
  169.     'Currently no existing bookings or reservations
  170.     'Ok to save record and close
  171.     DoCmd.RunCommand acCmdSaveRecord
  172.     DoCmd.Close
  173.     Exit Function
  174. End If
  175.  
  176. rs.MoveFirst
  177.  
  178. Do Until rs.EOF
  179.  
  180. If StartDate = rs!DateCheckedOut And EndDate = rs!DueDate Then
  181.     If Me.EquipmentID = "MLAP-SET01" Or Me.EquipmentID = "MLAP-SET02" Or Me.EquipmentID = "MTAB-SET01" Or Me.EquipmentID = "MTAB-SET02" Or Me.EquipmentID = "MTAB-SET03" Or Me.EquipmentID = "MTAB-676c" Or Me.EquipmentID = "MTAB-677c" Or Me.EquipmentID = "MTAB-678c" Or Me.EquipmentID = "MTAB-679c" Or Me.EquipmentID = "MTAB-680c" Or Me.EquipmentID = "MTAB-681c" Or Me.EquipmentID = "MTAB-682c" Or Me.EquipmentID = "MTAB-683c" Or Me.EquipmentID = "MTAB-684c" Or Me.EquipmentID = "MTAB-685c" Then
  182.         'Perform additional time tests for netbook sets
  183.         If IsNull(TimeOut) Or IsNull(TimeIn) Then
  184.             MsgBox "Please enter time values", vbOKOnly
  185.             Cancel = True
  186.             Me.TimeOut.SetFocus
  187.             rs.Close
  188.             Set rs = Nothing
  189.             Set db = Nothing
  190.             Exit Function
  191.         Else
  192.             If TimeOut = rs!TimeOut Or TimeIn = rs!TimeIn Then
  193.                 test = True
  194.             ElseIf TimeOut >= rs!TimeOut And TimeOut <= rs!TimeIn Then
  195.                 test = True
  196.             ElseIf TimeIn <= rs!TimeIn And TimeIn >= rs!TimeOut Then
  197.                 test = True
  198.             End If
  199.         End If
  200.     Else
  201.         test = True
  202.     End If
  203. ElseIf StartDate = rs!DateCheckedOut Or EndDate = rs!DueDate Then
  204.     test = True
  205. ElseIf StartDate >= rs!DateCheckedOut And StartDate <= rs!DueDate Then
  206.     test = True
  207. ElseIf EndDate <= rs!DueDate And EndDate >= rs!DateCheckedOut Then
  208.     test = True
  209. ElseIf StartDate <= rs!DateCheckedOut And EndDate >= rs!DateCheckedOut Then
  210.     test = True
  211. End If
  212.  
  213. If test Then
  214.     rs.MoveLast
  215.     rs.MoveNext
  216. Else
  217.     rs.MoveNext
  218. End If
  219.  
  220. Loop
  221.  
  222. rs.Close
  223.  
  224. If test = False Then
  225.     'Dates selected are ok
  226.     'Continue to save record and close window
  227.     DoCmd.RunCommand acCmdSaveRecord
  228.     MsgBox "Reservation Saved", vbOKOnly + vbInformation, "Reservation Saved"
  229.     DoCmd.Close
  230. Else
  231.     'Display error message to user
  232.     MsgBox "The dates you have selected clash with an existing booking/reservation. Please choose different dates.", vbOKOnly + vbExclamation, "Reservation Clash"
  233.     'Cancel
  234.     Cancel = True
  235.     Me.DateCheckedOut.SetFocus
  236.  
  237.     Set rs = Nothing
  238.     Set db = Nothing
  239.  
  240.     Exit Function
  241. End If
  242.  
  243. Set rs = Nothing
  244. Set db = Nothing
  245.  
  246. End Function
  247.  
  248. Private Sub Form_Load()
  249.  
  250. If Me.EquipmentID = "MLAP-SET01" Or Me.EquipmentID = "MLAP-SET02" Or Me.EquipmentID = "MTAB-SET01" Or Me.EquipmentID = "MTAB-SET02" Or Me.EquipmentID = "MTAB-SET03" Or Me.EquipmentID = "MTAB-676c" Or Me.EquipmentID = "MTAB-677c" Or Me.EquipmentID = "MTAB-678c" Or Me.EquipmentID = "MTAB-679c" Or Me.EquipmentID = "MTAB-680c" Or Me.EquipmentID = "MTAB-681c" Or Me.EquipmentID = "MTAB-682c" Or Me.EquipmentID = "MTAB-683c" Or Me.EquipmentID = "MTAB-684c" Or Me.EquipmentID = "MTAB-685c" Then
  251.     Me.TimeIn.Visible = True
  252.     Me.TimeOut.Visible = True
  253. End If
  254.  
  255. End Sub
  256.  
  257.  
May 28 '14 #1
Share this Question
Share on Google+
12 Replies


NeoPa
Expert Mod 15k+
P: 31,769
You may want to consider working with Date/Time values rather than separate dates and times. It's possible to do it the latter way, but more (and unnecessarily so) complicated (As you've already found of course).
May 28 '14 #2

P: 5
Thanks for taking the time to look and reply NeoPa. I am assuming you mean changing from Short Time to General Date. I have tried this and it makes no difference. If I can boil the problem into one short paragraph, it would be this. The database macro will let me reserve the same equipment multiple times within one day. It will also permit me to reserve one item over the duration of more than one day. It won't let me reserve the 2 concurrently. There a several macros, besides the reserve item, not least a book item and an an update reservation to click out and return the item on collection and return. TimeOut, DateCheckedOut, DueDate and TimeIn were in Short Time Format. I changed them all to General Date, but the result is the same. Is there a different date format I should use or due you mean I should write the code in the macro differently?
May 29 '14 #3

NeoPa
Expert Mod 15k+
P: 31,769
The format is entirely irrelevant :-(

If you store the date and the time of the points in time you're working with then you will find it easier to work with them. Instead of saying :
Expand|Select|Wrap|Line Numbers
  1. Is Date1 < Date2 AND Is Time1 < Time2 Then
you can do far simpler comparisons similar to :
Expand|Select|Wrap|Line Numbers
  1. Is DateTime1 < DateTime2 Then
That's pseudo-code of course, but do you see what I'm trying to say?
May 29 '14 #4

P: 5
Forgive me for being niaive here as I'm on a steep learning curve. Basically I used the find/replace aid to replace all references in the macros for Date and Time alone to DateTime. I then changed the control sources in the forms in design view to reflect the changes. When I ran the project I get the follwing error.
"Compile error

Method or data member not found"

When the debugger comes up indicates it doesn't recognise the

term Me.DateTimeIn.Visble:

Expand|Select|Wrap|Line Numbers
  1. Private Sub Form_Load ()
  2. If Me.EquipmentID = "MLAP-SET01" Or Me.EquipmentID = "MLAP-SET02" Or Me.EquipmentID = "MTAB-SET01" Or Me.EquipmentID = "MTAB-SET02" Or Me.EquipmentID = "MTAB-SET03" Or Me.EquipmentID = "MTAB-676c" Or Me.EquipmentID = "MTAB-677c" Or Me.EquipmentID = "MTAB-678c" Or Me.EquipmentID = "MTAB-679c" Or Me.EquipmentID = "MTAB-680c" Or Me.EquipmentID = "MTAB-681c" Or Me.EquipmentID = "MTAB-682c" Or Me.EquipmentID = "MTAB-683c" Or Me.EquipmentID = "MTAB-684c" Or Me.EquipmentID = "MTAB-685c" Then
  3.     Me.DateTimeIn.Visible = True
  4.     Me.DateTimeOut.Visible = True
  5. End If
  6.  
What am I doing wrong please?
May 30 '14 #5

Expert 100+
P: 1,240
BitesBoy,
You've tried to take a shortcut by mass replacing one thing with another. You should have gone painstakingly through the code to verify what you were doing. You changed the name of one thing in the code to some other thing but that thing does exist. You have no object on your form called DateTimeIn and DateTimeOut.

Here's what may get you to your quickest fix. Go back to your original code. You can combine a date and time into one DateTime variable simply by concatenating. Like this:
Expand|Select|Wrap|Line Numbers
  1. Dim dtOut as Date
  2. dim dtIn as Date
  3. dtOut = me.DateOut & " " & me.TimeOut
  4. dtIn = me.DateIn & " " & me.TimeIn
  5. if dtIn > dtOut then
  6.  msgbox "error"
  7. end if
You might also find the information here helpful if you really want to learn about handling dates and times. It's an old link but I think info is still all relevant:
http://support.microsoft.com/kb/210604

Jim
May 30 '14 #6

NeoPa
Expert Mod 15k+
P: 31,769
No problem for finding it confusing BitesBoy. I suspect you were more floundering than looking for a shortcut, but nevertheless Jim's post throws some light on the point I was trying to get across.

Basically, when working with timestamps (a point in time with a date and time element) it is better to hold all the information as a single value than trying to specify it with two separate values - to whit a date and a time.

How you interact with the user is up to you. They can enter it separately or as a single value, as long as any separate entry is followed automatically by joining them together for storing.

Jim's illustration makes it fairly clear why this makes sense.
May 30 '14 #7

Expert 100+
P: 1,240
I'm sorry if I came across harshly, it was not my intent. I think we all want posters to feel eager to come back for more help and advice.

Let us know how this turned out, BitesBoy.

Jim
May 30 '14 #8

P: 5
No offense taken Jim. I can see why someone looking on the outside in, with limited prior knowledge, could not help but think I was taking the lazier route. But if the truth be told, NeoPa was on the money when he suspected I was floundering. If I was to give your site the full background as to how I ended up working on this database, I'd probably have to give you as much info as I submitted for the code in the one module I uploaded.

The short version is my knowledge of databases and Visual Basic goes back a decade. All my dB knowledge gained then was on Access 2003 and used purely to get a qualification. Life, either by work or private projects, offered me no further incentives to continue using that knowledge. That is until a few months ago when I inherited this database from someone who left our employ, who clearly knew how to create a fully relational, macro-enabled database. And yet for the creator's knowledge and skills, you will have gathered from my query that even the creator clearly did not have the definitive knowledge required to provide full functionality to the database.

So when I did take up the challenge I found that the back-end and front-end changes in Access 2010 compared to 2003 to be like night and day. Whether I like it or not, with no one else with the knowledge to maintain it I inherited the role of maintaining the database .

For all my shortcomings, through sheer doggedness and trial and error, I have managed to master a lot of the requirements necessary to maintain it. So thank you for your, and NeoPa's patience in baring with some of my rather naive response.

My rant is nearly over. I'm impressed by the speed of responses on this site, yours and NeoPa's. It is truly heartening that there are people in the community who are prepared to offer their advice freely. I also realise that this medium is not always the best way to convey and transmit thoughts and requests, because the nature of learning computing skills, whether applications or programming, is often learned best by seeing things in action. Perhaps screen recordings of the effects people are trying to convey might enhance this.

I look forward to implementing your coding changes, but will only be able to tackle this on Monday at work, where I have access to Access2010. At home I still only have the older technology.

Thanks again,
BitesBoy
May 31 '14 #9

NeoPa
Expert Mod 15k+
P: 31,769
That's all perfectly reasonable :-)

If you think it would help, I can put you in touch with someone who can help professionally with teaching and helping you directly in your project at the same time. She is a fellow Access MVP and specialises in such 'training on the job'.

Let me know if you're interested and I'll PM you her details. She's very experienced and will certainly be able to take you forward. I can't say what her rates are, but I suspect they're very reasonable - as long as you remember it's a professional service (Some people seem to believe they can get hours of professional service for the price of a pint of beer).

Check her (Crystal Long) out on :
Learn Access Playlist on YouTube
Jun 1 '14 #10

P: 5
I tried the new date time format advised by NeoPa and detailed by Jim. Unfortunately, it did not work. At first I ran it and it threw up an object issue me at the bottom:
Expand|Select|Wrap|Line Numbers
  1.  Me.TimeOut.Visible = True
  2.         Me.TimeIn.Visible = True
I changed the code for these 2 lines back and it ran, but still didn't provide the desired affects. I wondered if you might be so kind to look over the code changes I made and comment if there is anything amiss?

Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2.  
  3. Private Sub Form_Current()
  4.  
  5. varDuration = DLookup("DefaultLoanDuration", "Equipment", "EquipmentID = '" & Nz(Me.EquipmentID, "") & "'")
  6. Me.txtDuration = varDuration
  7.  
  8. End Sub
  9.  
  10. Public Function CheckValidReservationOld(Cancel As Integer)
  11.  
  12. Dim db As DAO.Database, rs As DAO.Recordset
  13. Dim intnewrec As Integer
  14. Dim dtOut As Date
  15. Dim dtIn As Date
  16. Dim dtDue As Date
  17.  
  18. Set db = CurrentDb()
  19. Set rs = db.OpenRecordset("SELECT EquipmentID, DateCheckedOut, DueDate, IsReservation FROM Loan WHERE EquipmentID='" & Me.EquipmentID & "' AND (IsReservation=True OR DateCheckedIn Is Null) ORDER BY DateCheckedOut ASC")
  20.  
  21. dtOut = Me.DateCheckedOut & " " & Me.TimeOut
  22. dtIn = Me.DateCheckedIn & " " & Me.TimeIn
  23. dtDue = Me.DueDate & " " & Me.TimeIn
  24.  
  25. If dtIn < dtOut Then
  26.     MsgBox "Date reserved to cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Warning"
  27.     Cancel = True
  28.     Exit Function
  29. End If
  30.  
  31. If dtDue < dtOut Then
  32.     MsgBox "Due Date cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Warning"
  33.     Cancel = True
  34.     Exit Function
  35. End If
  36.  
  37. If rs.RecordCount > 0 And rs.RecordCount <> -1 Then
  38.     MsgBox "Reservations or loans exist", vbOKOnly
  39.     'Item already has one or more reservations
  40.     'Need to check if the new reservation clashes with any existing reservations or bookings
  41.     rs.MoveFirst
  42.     Do While Not rs.EOF
  43.  
  44.         If dtOut >= rs!dtOut And dtDue <= rs!Due Then
  45.             MsgBox "Dates clash with an existing booking/reservation", vbOKOnly, "Reservation Exists"
  46.             Cancel = True
  47.             dtOut.SetFocus
  48.             Exit Function
  49.         'If (Me.DateCheckedOut >= rs!DateCheckedOut And Me.DueDate <= rs!DueDate) Then
  50.             'MsgBox "Dates clash with an existing booking/reservation", vbOKOnly, "Reservation Exists"
  51.             'Cancel = True
  52.             'Me.DateCheckedOut.SetFocus
  53.             'Exit Function
  54.         Else
  55.             'Continue to save record and close window
  56.             DoCmd.RunCommand acCmdSaveRecord
  57.             DoCmd.Close
  58.         End If
  59.     Loop
  60. Else
  61.     'No reservations exist
  62.     'Continue to save record and close window
  63.     DoCmd.RunCommand acCmdSaveRecord
  64.     DoCmd.Close
  65. End If
  66.  
  67. End Function
  68.  
  69.  
  70. 'Public Function CheckValidReservation(Cancel As Integer)
  71. '
  72. 'Dim db As DAO.Database, rs As DAO.Recordset
  73. 'Dim intnewrec As Integer
  74. '
  75. 'Set db = CurrentDb()
  76. '
  77. 'If Me.DueDate < Me.DateCheckedOut Then
  78. '    MsgBox "Due Date cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Date Error"
  79. '    Cancel = True
  80. '    Exit Function
  81. 'End If
  82. '
  83. 'Set rs = db.OpenRecordset("SELECT EquipmentID, DateCheckedOut, DueDate, IsReservation FROM Loan WHERE EquipmentID='" & Me.EquipmentID & "' AND (IsReservation=True OR DateCheckedIn Is Null) AND (DateCheckedOut>=Date()) ORDER BY DateCheckedOut ASC")
  84. '
  85. 'StartDate = Me.DateCheckedOut
  86. 'EndDate = Me.DueDate
  87. '
  88. 'test = False
  89. '
  90. 'If rs.RecordCount = 0 Then
  91. '    'Currently no existing bookings or reservations
  92. '    'Ok to save record and close
  93. '    DoCmd.RunCommand acCmdSaveRecord
  94. '    DoCmd.Close
  95. '    Exit Function
  96. 'End If
  97. '
  98. 'rs.MoveFirst
  99. '
  100. 'Do Until rs.EOF
  101. '
  102. 'If StartDate = rs!DateCheckedOut Or EndDate = rs!DueDate Then
  103. '    test = True
  104. 'ElseIf StartDate >= rs!DateCheckedOut And StartDate <= rs!DueDate Then
  105. '    test = True
  106. 'ElseIf EndDate <= rs!DueDate And EndDate >= rs!DateCheckedOut Then
  107. '    test = True
  108. 'End If
  109. '
  110. 'If test Then
  111. '    rs.MoveLast
  112. '    rs.MoveNext
  113. 'Else
  114. '    rs.MoveNext
  115. 'End If
  116. '
  117. 'Loop
  118. '
  119. 'rs.Close
  120. '
  121. 'If test = False Then
  122. '    'Dates selected are ok
  123. '    'Continue to save record and close window
  124. '    DoCmd.RunCommand acCmdSaveRecord
  125. '    MsgBox "Reservation Saved", vbOKOnly + vbInformation, "Reservation Saved"
  126. '    DoCmd.Close
  127. 'Else
  128. '    'Display error message to user
  129. '    MsgBox "The dates you have selected clash with an existing booking/reservation. Please choose different dates.", vbOKOnly + vbExclamation, "Reservation Clash"
  130. '    'Cancel
  131. '    Cancel = True
  132. '    Me.DateCheckedOut.SetFocus
  133. '
  134. '    Set rs = Nothing
  135. '    Set db = Nothing
  136. '
  137. '    Exit Function
  138. 'End If
  139. '
  140. 'Set rs = Nothing
  141. 'Set db = Nothing
  142. '
  143. 'End Function
  144.  
  145. Public Function CheckValidReservation(Cancel As Integer)
  146.  
  147. Dim db As DAO.Database, rs As DAO.Recordset
  148. Dim intnewrec As Integer
  149.  
  150. Set db = CurrentDb()
  151.  
  152. If dtDue < dtOut Then
  153.     MsgBox "Due Date cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Date Error"
  154.     Cancel = True
  155.     Exit Function
  156. End If
  157.  
  158. If dtDue = dtOut And Format(dtIn, "Short Time") < Format(dtOut, "Short Time") Then
  159.     MsgBox "Due Date cannot be before the Reservation From date", vbOKOnly + vbExclamation, "Time Error"
  160.     Cancel = True
  161.     Exit Function
  162. End If
  163.  
  164.  
  165. Set rs = db.OpenRecordset("SELECT EquipmentID, DateCheckedOut, DueDate, TimeOut, TimeIn, IsReservation FROM Loan WHERE EquipmentID='" & Me.EquipmentID & "' AND (IsReservation=True OR DateCheckedIn Is Null) AND (DateCheckedOut>=Date()) ORDER BY DateCheckedOut ASC")
  166.  
  167. StartDate = dtOut
  168. EndDate = dtDue
  169. TimeOut = Format(dtOut, "Short Time")
  170. TimeIn = Format(dtIn, "Short Time")
  171.  
  172. test = False
  173.  
  174. If rs.RecordCount = 0 Then
  175.     'Currently no existing bookings or reservations
  176.     'Ok to save record and close
  177.     DoCmd.RunCommand acCmdSaveRecord
  178.     DoCmd.Close
  179.     Exit Function
  180. End If
  181.  
  182. rs.MoveFirst
  183.  
  184. Do Until rs.EOF
  185.  
  186. If StartDate = rs!dtOut And EndDate = rs!dtDue Then
  187.     If Me.EquipmentID = "MLAP-SET01" Or Me.EquipmentID = "MLAP-SET02" Or Me.EquipmentID = "MTAB-SET01" Or Me.EquipmentID = "MTAB-SET02" Or Me.EquipmentID = "MTAB-SET03" Or Me.EquipmentID = "MTAB-676c" Or Me.EquipmentID = "MTAB-677c" Or Me.EquipmentID = "MTAB-678c" Or Me.EquipmentID = "MTAB-679c" Or Me.EquipmentID = "MTAB-680c" Or Me.EquipmentID = "MTAB-681c" Or Me.EquipmentID = "MTAB-682c" Or Me.EquipmentID = "MTAB-683c" Or Me.EquipmentID = "MTAB-684c" Or Me.EquipmentID = "MTAB-685c" Then
  188.         'Perform additional time tests for netbook sets
  189.         If IsNull(dtIn) Or IsNull(dtOut) Then
  190.             MsgBox "Please enter time values", vbOKOnly + vbExclamation, "Enter Times"
  191.  
  192.             Cancel = True
  193.             dtOut.SetFocus
  194.             rs.Close
  195.             Set rs = Nothing
  196.             Set db = Nothing
  197.             Exit Function
  198.         Else
  199.             If TimeOut = rs!dtOut Or TimeIn = rs!dtIn Then
  200.                 test = True
  201.             ElseIf TimeOut >= rs!dtOut And TimeOut <= rs!dtIn Then
  202.                 test = True
  203.             ElseIf TimeIn <= rs!dtIn And TimeIn >= rs!dtOut Then
  204.                 test = True
  205.             End If
  206.         End If
  207.     Else
  208.         test = True
  209.     End If
  210. ElseIf StartDate = rs!dtOut Or EndDate = rs!dtDue Then
  211.     test = True
  212. ElseIf StartDate >= rs!dtOut And StartDate <= rs!dtDue Then
  213.     test = True
  214. ElseIf EndDate <= rs!dtDue And EndDate >= rs!dtOut Then
  215.     test = True
  216. ElseIf StartDate <= rs!dtOut And EndDate >= rs!dtOut Then
  217.     test = True
  218. End If
  219.  
  220. If test Then
  221.     rs.MoveLast
  222.     rs.MoveNext
  223. Else
  224.     rs.MoveNext
  225. End If
  226.  
  227. Loop
  228.  
  229. rs.Close
  230.  
  231. If test = False Then
  232.     'Dates selected are ok
  233.     'Continue to save record and close window
  234.     DoCmd.RunCommand acCmdSaveRecord
  235.     MsgBox "Reservation Saved", vbOKOnly + vbInformation, "Reservation Saved"
  236.     DoCmd.Close
  237. Else
  238.     'Display error message to user
  239.     MsgBox "The dates you have selected clash with an existing booking/reservation. Please choose different dates.", vbOKOnly + vbExclamation, "Reservation Clash"
  240.     'Cancel
  241.     Cancel = True
  242.     dtOut.SetFocus
  243.  
  244.     Set rs = Nothing
  245.     Set db = Nothing
  246.  
  247.     Exit Function
  248. End If
  249.  
  250. Set rs = Nothing
  251. Set db = Nothing
  252.  
  253. End Function
  254.  
  255. Private Sub Form_Load()
  256.  
  257. If Me.EquipmentID = "MLAP-SET01" Or Me.EquipmentID = "MLAP-SET02" Or Me.EquipmentID = "MTAB-SET01" Or Me.EquipmentID = "MTAB-SET02" Or Me.EquipmentID = "MTAB-SET03" Or Me.EquipmentID = "MTAB-676c" Or Me.EquipmentID = "MTAB-677c" Or Me.EquipmentID = "MTAB-678c" Or Me.EquipmentID = "MTAB-679c" Or Me.EquipmentID = "MTAB-680c" Or Me.EquipmentID = "MTAB-681c" Or Me.EquipmentID = "MTAB-682c" Or Me.EquipmentID = "MTAB-683c" Or Me.EquipmentID = "MTAB-684c" Or Me.EquipmentID = "MTAB-685c" Then
  258.         Me.TimeOut.Visible = True
  259.         Me.TimeIn.Visible = True
NeoPa, thanks for offering as a contact Crystal Long for possible on the job training. I like the sound of this, provided she knows how to offer advice on the Vba side and that she doesn't charge Bill Gates rates.

I will have a look at her play list tonight.
Jun 2 '14 #11

Expert 100+
P: 1,240
Bitesboy, what is the problem? What is the error and how are you arriving at it? You click a button to make that happen?

I see that CheckValidReservationOld looks pretty good. But CheckValidReservation makes references to dtIn and dtOut without giving them any value. They are not the same variables as in CheckValidReservationOld because the "scope" of those variables is the subroutine they are defined in. So if the problem is occurring in CheckValidReservation you should start by copying your dtIn= and dtOut= code from CheckValidReservationOld.

Be clear about your current problem each time you post. We cannot know what you have done and what new result you are getting.

Jim
Jun 2 '14 #12

NeoPa
Expert Mod 15k+
P: 31,769
For help with code you need to be a lot clearer with what the problem is and generally need a fairly small amount of code. A code review of 250+ lines is not something many will get themselves into in their spare/volunteer time. If anyone does then they'd be looking for much clearer indications of what is what.

I say this, not to chasten or chastise, but to give you a better understanding of what you can reasonably expect help with, and what is likely to put people off from helping you. If you can identify where the problem is then people are generally prepared to spend some time helping you pinpoint it.

As for the Crystal thing - I'll PM you on that separately.
Jun 2 '14 #13

Post your reply

Sign in to post your reply or Sign up for a free account.