Sam Summers
Registered User.
- Local time
- Today, 13:56
- Joined
- Sep 17, 2001
- Messages
- 939
Hi guys
I have a form called 'PitchAllocate' on which there are buttons which relate to pitches on a campsite.
When the user clicks on the button a modal form called 'EnterEmail' is displayed where the user simply types in the guests email address and hits the 'Enter' key and the email is sent.
This all works absolutely perfectly but all i want is for the form to close after the confirmation msgbox has been displayed but i get the message as in the attached picture?
I have tried all kinds of things like changing it to not modal but i do have the form set as 'pop up'. I stepped through the code but i am clearly missing something simple?
I was wondering if it is still sending the email when i am trying to close the form?
Its failing on the last line of code ' DoCmd.Close acForm, "EnterEmail", acSaveNo'
Many thanks for your help in advance
Sam
I have a form called 'PitchAllocate' on which there are buttons which relate to pitches on a campsite.
When the user clicks on the button a modal form called 'EnterEmail' is displayed where the user simply types in the guests email address and hits the 'Enter' key and the email is sent.
This all works absolutely perfectly but all i want is for the form to close after the confirmation msgbox has been displayed but i get the message as in the attached picture?
I have tried all kinds of things like changing it to not modal but i do have the form set as 'pop up'. I stepped through the code but i am clearly missing something simple?
I was wondering if it is still sending the email when i am trying to close the form?
Its failing on the last line of code ' DoCmd.Close acForm, "EnterEmail", acSaveNo'
Many thanks for your help in advance
Sam
Code:
Option Compare Database
Option Explicit
Private Sub GuestEmail_LostFocus()
Select Case Me.PitchNo = "1"
Case Is = True
SendAttachmentEmail Array("C:\Bunchrew custom DBs\Pitch1.png")
Forms!PitchAllocate!Pitch1Btn.BackColor = RGB(255, 0, 0)
Forms!PitchAllocate!Position1QrySubform.Form!Occupied = True
Forms!PitchAllocate.Requery
Case Else
End Select
Select Case Me.PitchNo = "2"
Case Is = True
SendAttachmentEmail Array("C:\Bunchrew custom DBs\Pitch2.png")
Forms!PitchAllocate!Pitch2Btn.BackColor = RGB(255, 0, 0)
Forms!PitchAllocate!Position2QrySubform.Form!Occupied = True
Forms!PitchAllocate.Requery
Case Else
End Select
Select Case Me.PitchNo = "3"
Case Is = True
SendAttachmentEmail Array("C:\Bunchrew custom DBs\Pitch3.png")
Forms!PitchAllocate!Pitch3Btn.BackColor = RGB(255, 0, 0)
Forms!PitchAllocate!Position3QrySubform.Form!Occupied = True
Forms!PitchAllocate.Requery
Case Else
End Select
Select Case Me.PitchNo = "4"
Case Is = True
SendAttachmentEmail Array("C:\Bunchrew custom DBs\Pitch4.png")
Forms!PitchAllocate!Pitch4Btn.BackColor = RGB(255, 0, 0)
Forms!PitchAllocate!Position4QrySubform.Form!Occupied = True
Forms!PitchAllocate.Requery
Case Else
End Select
Dim intResult As Integer
End Sub
Function SendAttachmentEmail(Optional AttachmentPath As Variant)
'idea modified from https://www.devhut.net/2010/09/03/vba-outlook-automation/
'Send Email using late binding to avoid reference issues
Dim strTo As String
Dim strSubject As String
Dim strBody As String
Dim blnEdit As Boolean
Dim cPitch As String
Dim strText As String
Dim objOutlook As Object
Dim objOutlookMsg As Object
Dim objOutlookRecip As Object
Dim objOutlookAttach As Object
Dim i As Integer
Const olMailItem = 0
If IsNull(GuestEmail) Then
DoCmd.Beep
MsgBox "You must enter an email address", vbExclamation, "Bunchrew Pitch Allocator"
Me.GuestEmail.SetFocus
Else
Select Case Me.PitchNo = "1"
Case Is = True
cPitch = Forms!PitchAllocate!Position1QrySubform.Form!Location
Case Else
End Select
Select Case Me.PitchNo = "2"
Case Is = True
cPitch = Forms!PitchAllocate!Position2QrySubform.Form!Location
Case Else
End Select
Select Case Me.PitchNo = "3"
Case Is = True
cPitch = Forms!PitchAllocate!Position3QrySubform.Form!Location
Case Else
End Select
Select Case Me.PitchNo = "4"
Case Is = True
cPitch = Forms!PitchAllocate!Position4QrySubform.Form!Location
Case Else
End Select
Dim intResult As Integer
strText = "Please click on this link or scan the QR code in the attachment for what3words to guide you to your pitch "
strTo = Me.GuestEmail
strSubject = "Your Pitch location at Bunchrew Caravan Park"
strBody = strText & vbNewLine & vbNewLine & _
cPitch & vbNewLine & _
" " & vbNewLine & _
"Kind regards , Bunchrew Caravan Park"
blnEdit = True
' On Error GoTo ErrorMsgs
Set objOutlook = CreateObject("Outlook.Application")
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
Set objOutlookRecip = .Recipients.Add(strTo)
objOutlookRecip.Type = 1
.Subject = strSubject
.Body = strBody
' Add attachments to the message if there are some.
'First check if there are attachments to add (passed into the function):
If Not IsMissing(AttachmentPath) Then
'are there multiple attachments?
If IsArray(AttachmentPath) Then
For i = LBound(AttachmentPath) To UBound(AttachmentPath) '- 1
If AttachmentPath(i) <> "" And AttachmentPath(i) <> "False" Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath(i))
End If
Next i
Else
'is there only 1 attachment?
If AttachmentPath <> "" Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
End If
End If
For Each objOutlookRecip In .Recipients
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
' If blnEdit Then
'edit mode first then send
' .Display
' Else
'transparent/silent send and
.Send
' End If
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing
Forms!PitchAllocate.Requery
DoCmd.Beep
MsgBox "Message sent", vbInformation, "Bunchrew Pitch Allocator"
DoCmd.Close acForm, "EnterEmail", acSaveNo
'ErrorMsgs:
' If Err.Number = "287" Then
' MsgBox "You clicked No to the Outlook security warning. " & _
' "Rerun the procedure and click Yes to access e-mail " & _
' "addresses to send your message. For more information, " & _
' "see the document at http://www.microsoft.com/office" & _
' "/previous/outlook/downloads/security.asp."
' Exit Function
' ElseIf Err.Number <> 0 Then
' MsgBox Err.Number & " - " & Err.Description
' Exit Function
' DoCmd.Close
' End If
End If
End Function