vba coding

  • Thread starter Thread starter Jack1992
  • Start date Start date
J

Jack1992

Hi,

I am working on a project for booking courses and below is the code I am
using in vba to make error boxes come up:

Option Compare Database

Private Sub btn_book_event_Click()
On Error GoTo Err_btn_book_event_Click


Dim MsgBoxTxt As String

Dim Places As String



Places = DCount("*", "Booking", "[Course ID] = ComboCourse")



If DCount("*", "Booking", "[Course ID]=ComboCourse") < 20 Then



MsgBoxTxt = "Event is Booked." & Places & " places are already booked and
there are " & 20 - Places & " places left."



Else

MsgBoxTxt = "Event is full with " & Places & " places taken out of 20.
Sorry, this Course can not be booked."

DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70



End If



MsgBox MsgBoxTxt



DoCmd.DoMenuItem acFormBar, acRecordMenu, acSaveRecord, , acMenuVer70



If DCount("*", "Booking", "[Course ID]=ComboCourse and [CustomerID] =
FormCustomerID") >= 1 Then

MsgBoxTxt = "Customer has already been booked on this course"

DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70

End If



MsgBox MsgBoxTxt

DoCmd.DoMenuItem acFormBar, acRecordMenu, acSaveRecord, , acMenuVer70


Exit_btn_book_event_Click:
Exit Sub

Err_btn_book_event_Click:
MsgBox Err.Description
Resume Exit_btn_book_event_Click

End Sub

Long code but errors occur.

I will click the button to run this, it says the first text box however it
then will say 'You cancelled the previous operation.'

Anyone have any idea why this is happening?
 
I think your undo is the problem and your programme flow

Try

Option Compare Database

Private Sub btn_book_event_Click()
On Error GoTo Err_btn_book_event_Click

Dim MsgBoxTxt As String
Dim Places As String

Places = DCount("*", "Booking", "[Course ID] = ComboCourse")

'Check if booked on first

If DCount("*", "Booking", "[Course ID]=ComboCourse and [CustomerID] =
FormCustomerID") >= 1 Then

MsgBoxTxt = "Customer has already been booked on this course"

'Show message
MsgBox MsgBoxTxt

'Undo Booking
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70

'Exit as you do not whant to run the rest of the code
Exit Sub

End If

'Check if available
If Places < 20 Then

MsgBoxTxt = "Event is Booked." & Places & " places are already booked and
there are " & 20 - Places & " places left."

MsgBox MsgBoxTxt

DoCmd.DoMenuItem acFormBar, acRecordMenu, acSaveRecord, , acMenuVer70

Else

MsgBoxTxt = "Event is full with " & Places & " places taken out of 20.
Sorry, this Course can not be booked."

DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70

End If


Exit_btn_book_event_Click:
Exit Sub

Err_btn_book_event_Click:
MsgBox Err.Description
Resume Exit_btn_book_event_Click

End Sub


or you could use

If already booked then
code
Elseif free places then
code
else
code
End If
 
Also there are other errors.

The variable "Places" is declared as a string, but shoould be declared as an
Integer because you are trying to do math on it.

There are errors in the "Where" argument of the DCOUNT() function.

If "ComboCourse" is a combo box on the form and the bound column is a
number, it should look like:

Places = DCount("*", "Booking", "[Course ID] = " & Me.ComboCourse)

Same with the other DCOUNT():

DCount("*", "Booking", "[Course ID] = " & Me.ComboCourse & " and
[CustomerID] = " & Me.FormCustomerID)

The Msgbox command is missing when the cource is full.

Here is my version:
'-----------end code---------------------

'---these two lines should be at the top of every code page--------
Option Compare Database
Option Explicit
'-----------------------------------------------------------------------

Private Sub btn_book_event_Click()
On Error GoTo Err_btn_book_event_Click

Dim MsgBoxTxt As String
Dim Places As Integer

Places = 0
Places = DCount("*", "Booking", "[Course ID] = " & Me.ComboCourse)

'first, Check if Customer booked
If DCount("*", "Booking", "[Course ID] = " & Me.ComboCourse & " and
[CustomerID] = " & Me.FormCustomerID) > 0 Then

MsgBoxTxt = "Customer has already been booked on this course"
'Show message
MsgBox MsgBoxTxt

'Undo Booking
'DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
Me.Undo

'Exit as you do not whant to run the rest of the code
Exit Sub

End If

'Check if place(s) available
If Places = 20 Then
'all booked
MsgBoxTxt = "Event is full with " & Places & " places taken out of 20."
MsgBoxTxt = MsgBoxTxt & vbCrLf & vbCrLf
MsgBoxTxt = MsgBoxTxt & " Sorry, this Course can not be booked."
'Show message
MsgBox MsgBoxTxt

'Undo Booking
' DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70
Me.Undo
Else
' MsgBoxTxt = "Event is Booked." & Places & " places are already
booked and there are " & 20 - Places & " places left."
'still place(s) available
MsgBoxTxt = "Event is not fully Booked." & Places & " places are
already booked. "
MsgBoxTxt = MsgBoxTxt & vbCrLf & vbCrLf
MsgBoxTxt = MsgBoxTxt & " There are " & 20 - Places & " places left."
'Show message
MsgBox MsgBoxTxt

'save record
DoCmd.DoMenuItem acFormBar, acRecordMenu, acSaveRecord, , acMenuVer70
End If

Exit_btn_book_event_Click:
Exit Sub

Err_btn_book_event_Click:
MsgBox Err.Description
Resume Exit_btn_book_event_Click

End Sub
'-----------end code---------------------

HTH
--
Steve S
--------------------------------
"Veni, Vidi, Velcro"
(I came; I saw; I stuck around.)


David said:
I think your undo is the problem and your programme flow

Try

Option Compare Database

Private Sub btn_book_event_Click()
On Error GoTo Err_btn_book_event_Click

Dim MsgBoxTxt As String
Dim Places As String

Places = DCount("*", "Booking", "[Course ID] = ComboCourse")

'Check if booked on first

If DCount("*", "Booking", "[Course ID]=ComboCourse and [CustomerID] =
FormCustomerID") >= 1 Then

MsgBoxTxt = "Customer has already been booked on this course"

'Show message
MsgBox MsgBoxTxt

'Undo Booking
DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70

'Exit as you do not whant to run the rest of the code
Exit Sub

End If

'Check if available
If Places < 20 Then

MsgBoxTxt = "Event is Booked." & Places & " places are already booked and
there are " & 20 - Places & " places left."

MsgBox MsgBoxTxt

DoCmd.DoMenuItem acFormBar, acRecordMenu, acSaveRecord, , acMenuVer70

Else

MsgBoxTxt = "Event is full with " & Places & " places taken out of 20.
Sorry, this Course can not be booked."

DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70

End If


Exit_btn_book_event_Click:
Exit Sub

Err_btn_book_event_Click:
MsgBox Err.Description
Resume Exit_btn_book_event_Click

End Sub


or you could use

If already booked then
code
Elseif free places then
code
else
code
End If
Click to expand...
 
Hi,

Thanks both for your replies however I am getting compile errors then on
some lines and I am not sure how to fix this.

Thanks,

Jack
 
Back
Top