Application_ItemSend Still sends E-mail even if I cancel with a message box in outlook

[Turtleman10]

I am running outlook 2010

This is the chunk of code that has the message box in it If I select no it ends the proram but the E-mail still goes out. I need to cancel the E-mail all together. Anyone have any Idea what I did wrong?

 If strSubject = "KECCERT" Then
    
        Prompt$ = "Do you want to send this Cert to Kohler?"
        If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Attachment") = vbNo Then End
             
        strPartN = InputBox("Part Number", "Please insert Part number")
        
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
    
        strPO = InputBox("P.O", "Please insert P.O number")
        
        Set Item = Outlook.Application.ActiveInspector.CurrentItem
            
        Item.Subject = "PN_" + strPartN + "_SD_" + strShipDT + "_PO_" + strPO
        
        strSubjectA = strA + strShipDT + strPartN + strRev

    End If

 

[FractalWalk]

Did you try this? This prevents the email from sending in my Outlook 2010.

If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, " ") = vbNo Then 
     Cancel = True
else
     Other stuff happens. 
Endif

 

[Turtleman10]

Yes but I will try it again just in case.

 

[Turtleman10]

Odd that was one of the first things I tried. I must not have compiled. Thanks for the help.

 

[FractalWalk]

Perhaps it would help if we could see all of your code. The following works for me. If I click No, it does not send the e-mail.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim strSubject As String, strPartN As String, strShipDT As String, strPO As String, strDesc As String, strPiec As String

    strSubject = Item.Subject
    If strSubject = "KEC" Then
        strPartN = InputBox("Part Number", "Please insert Part number")
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
        strPO = InputBox("P.O", "Please insert P.O number")
        Item.Subject = "PN" + strPartN + "_SD_" + strShipDT + "_PO_" + strPO
    ElseIf strSubject = "GNC" Then
        strPartN = InputBox("Part Number", "Please insert Part number")
        strDesc = InputBox("Part Description", "Please insert Part Description")
        strPO = InputBox("P.O", "Please insert P.O number")
        strPiec = InputBox("Number of Pieces", "Please insert number of Pieces")
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
        Item.Subject = strPartN + ", " + strDesc + ", " + strPO + ", " + strPiec + ", " + strShipDT
    ElseIf strSubject = "KECCERT" Then
        Prompt$ = "Do you want to send this Cert to Kohler?"
        If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, " ") = vbNo Then
            Cancel = True
        Else
            strPartN = InputBox("Part Number", "Please insert Part number")
            strShipDT = InputBox("Ship Date", "Please insert Ship date")
            strPO = InputBox("P.O", "Please insert P.O number")
            strSubjectA = strA + strShipDT + strPartN + strRev
            Item.Subject = "PN" + strPartN + "_SD_" + strShipDT + "_PO_" + strPO
        End If
    End If

End Sub

 

[Turtleman10]

Your solution worked great thanks for the help.

 

[Turtleman10]

Looks like I am still having issues with my code no matter what I try it still sends the E-mail when I cancel.

If strSubject = "KECCERT" Then
    
        Prompt$ = "Do you want to send this Cert to Kohler?"
        If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Attachment") = vbNo Then Exit Sub
                
     End If
     
     If strSubject = "KECCERT" Then
     
        strPartN = InputBox("Part Number", "Please insert Part number")
        
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
    
        strPO = InputBox("P.O", "Please insert P.O number")
        
        strRev = InputBox("Revision", "Please insert Revision")
            
        Set Item = Outlook.Application.ActiveInspector.CurrentItem
            
        Item.Subject = "PN_" + strPartN + "_SD_" + strShipDT + "_PO_" + strPO
        
        strSubjectA = strA + strShipDT + strPartN + strRev
        
    End If

 

[FractalWalk]

I belive you have placed this code in the APplication_ItemSend event procedure. If so, then exiting the sub will not cancel the event it will just not read anymore code before the event.

You need to set the cancel to TRUE . Have you tried the code I provided? It utilizes Cancel = True. If that doesn't work for you, please post all of your code because it is hard to diagnose the problem unless we see it.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim strSubject As String, strPartN As String, strShipDT As String, strPO As String, strDesc As String, strPiec As String

    strSubject = Item.Subject
    If strSubject = "KEC" Then
        strPartN = InputBox("Part Number", "Please insert Part number")
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
        strPO = InputBox("P.O", "Please insert P.O number")
        Item.Subject = "PN" + strPartN + "_SD_" + strShipDT + "_PO_" + strPO
    ElseIf strSubject = "GNC" Then
        strPartN = InputBox("Part Number", "Please insert Part number")
        strDesc = InputBox("Part Description", "Please insert Part Description")
        strPO = InputBox("P.O", "Please insert P.O number")
        strPiec = InputBox("Number of Pieces", "Please insert number of Pieces")
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
        Item.Subject = strPartN + ", " + strDesc + ", " + strPO + ", " + strPiec + ", " + strShipDT
    ElseIf strSubject = "KECCERT" Then
        Prompt$ = "Do you want to send this Cert to Kohler?"
        If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, " ") = vbNo Then
            Cancel = True
        Else
            strPartN = InputBox("Part Number", "Please insert Part number")
            strShipDT = InputBox("Ship Date", "Please insert Ship date")
            strPO = InputBox("P.O", "Please insert P.O number")
            strSubjectA = strA + strShipDT + strPartN + strRev
            Item.Subject = "PN" + strPartN + "_SD_" + strShipDT + "_PO_" + strPO
        End If
    End If

End Sub

 

[Turtleman10]

Ok here is all my code I just cant figure this out

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Declaration
Dim strSubject As String
Dim strSubjectA As String
Dim strPartN As String
Dim strShipDT As String
Dim strPO As String
Dim strDesc As String
Dim strPiec As String
Dim myOrtK As String
Dim myOrtG As String
Dim strA As String
Dim strRev As String
Dim Filename As String
Dim Prompt$
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection

'Destination folder
    myOrtK = "R:\CERTS\KOHLER"
    myOrtG = "R:\CERTS\GENERAC"
    
    On Error Resume Next
    
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection

strSubject = Item.Subject
strA = Item.Subject

    If strSubject = "KECCERT" Then
    
        Prompt$ = "Do you want to send this Cert to Kohler?"
        If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Attachment") = vbNo Then Exit Sub
     
        strPartN = InputBox("Part Number", "Please insert Part number")
        
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
    
        strPO = InputBox("P.O", "Please insert P.O number")
        
        strRev = InputBox("Revision", "Please insert Revision")
            
        Set Item = Outlook.Application.ActiveInspector.CurrentItem
            
        Item.Subject = "PN_" + strPartN + "_SD_" + strShipDT + "_PO_" + strPO
        
        strSubjectA = strA + strShipDT + strPartN + strRev
    
    ElseIf strSubject = "GNCCERT" Then
    
    Prompt$ = "Do you want to send this Cert to Generac?"
        If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Attachment") = vbNo Then Cancel = True
             
        strPartN = InputBox("Part Number", "Please insert Part number")
    
        strDesc = InputBox("Part Description", "Please insert Part Description")
        
        strPO = InputBox("P.O", "Please insert P.O number")
    
        strPiec = InputBox("Number of Pieces", "Please insert number of Pieces")
        
        strShipDT = InputBox("Ship Date", "Please insert Ship date")
        
        strRev = InputBox("Revision", "Please insert Revision")
        
        Set Item = Outlook.Application.ActiveInspector.CurrentItem
        
        Item.Subject = strPartN + "," + strDesc + "," + strPO + "," + strPiec + "," + strShipDT
        
        strSubjectA = strA + strShipDT + strPartN + strRev
    
    On Error Resume Next
     
    'for all items do...
    For Each myItem In myOlSel
     
        'point on attachments
        Set myAttachments = myItem.Attachments
         
        'if there are some...
        If myAttachments.Count = 0 Then
        
        Prompt$ = "There are no attachments. Do you want to send the message anyway?"
        If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Attachment") = vbNo Then Exit Sub
             
        'save them to destination
        Filename = myOrtK & "\" & strSubjectA
        
        myAttachments.SaveAsFile Filename
        
        End If
        
     Next
     
End If
     
    'free variables
    Set myItems = Nothing
    Set myItem = Nothing
    Set myAttachments = Nothing
    Set myAttachment = Nothing
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
     
End Sub

 

[Turtleman10]

Yep I sure did It's the oddest thing it will go to the end of the if statement. the E-mail wont be sent but you still get the prompts.

 

[FractalWalk]

Again, this is your problem right here:
If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Attachment") = vbNo Then Exit Sub

Exiting the subroutine does not cancel the send event, it just leaves the rutine that is run before sending it. You need to cancel the event with Cancel = True and then leave the sub.

If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Attachment") = vbNo Then 
     Cancel = True
     Exit Sub
End if

 

[Turtleman10]

Perfect Thank your for your patiance. You have been very helpful.