Modal form not closing after code has run (1 Viewer)

Sam Summers

Registered User.
Local time
Today, 06:25
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

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
 

Attachments

  • Error Message.png
    Error Message.png
    1,018.8 KB · Views: 87

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 13:25
Joined
May 7, 2009
Messages
19,243
does the code in GuestEmail_LostFocus() get executed?
probably move the closing of the form on this sub, (before the end of the sub).
 

Sam Summers

Registered User.
Local time
Today, 06:25
Joined
Sep 17, 2001
Messages
939
does the code in GuestEmail_LostFocus() get executed?
probably move the closing of the form on this sub, (before the end of the sub).
Hi Arnel
Yes it all runs until i try and close the form?
 

Sam Summers

Registered User.
Local time
Today, 06:25
Joined
Sep 17, 2001
Messages
939
I just tried to move the focus to the Cancelbtn and then run the close command but still the same message?
 

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 06:25
Joined
Sep 12, 2006
Messages
15,656
put an error handler around the close from line (assuming that's the line you mean


Code:
on error goto fail 
msgbox "closing form" 'just to make sure it gets to this point
DoCmd.Close acForm, "EnterEmail", acSaveNo
exit sub

fail:
msgbox "Error: " & err & "    Desc: " & err.description
 

Sam Summers

Registered User.
Local time
Today, 06:25
Joined
Sep 17, 2001
Messages
939
put an error handler around the close from line (assuming that's the line you mean


Code:
on error goto fail
msgbox "closing form" 'just to make sure it gets to this point
DoCmd.Close acForm, "EnterEmail", acSaveNo
exit sub

fail:
msgbox "Error: " & err & "    Desc: " & err.description
So tried that and i now get this message
 

Attachments

  • 2nd Error message.png
    2nd Error message.png
    22.4 KB · Views: 90

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 06:25
Joined
Sep 12, 2006
Messages
15,656
Well there you are, that's why it's not closing. It's reaching that line of code, but the command is failing. I don't know why you haven't got the error message before. Do you have an "on error resume next" statement? If so that's the issue, as you are ignoring all errors, which isn't a safe thing to do, to be honest.

Are you running the code from the "Enter Email" form?
Can you use just not close the email form with the close button?
 

Sam Summers

Registered User.
Local time
Today, 06:25
Joined
Sep 17, 2001
Messages
939
Well there you are, that's why it's not closing. It's reaching that line of code, but the command is failing. I don't know why you haven't got the error message before. Do you have an "on error resume next" statement? If so that's the issue, as you are ignoring all errors, which isn't a safe thing to do, to be honest.

Are you running the code from the "Enter Email" form?
Can you use just not close the email form with the close button?
I just wanted it to be a bit slicker than after typing in the email address to then have to click a button but if there is no other way then.......

I will look into the "on error resume next"

Thank you
 

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 06:25
Joined
Sep 12, 2006
Messages
15,656
It might be that you are using the lost_focus event.

Try just having a command button that says "Send Email", with the same code. That might well work.
 

Users who are viewing this thread

Top Bottom