Application_ItemSend

[ldoodle]

Hey,

Is it possible to invoke this only for specific emails, namely those generated from a template (oft) file using VBA.

This is from my current project:

Sub GenerateEmail()

Dim App As Outlook.Application
Dim Item As Outlook.MailItem
Dim Template As String

Template = "C:\Dev\Email Template.oft"
Set App = CreateObject("Outlook.Application")
Set Item = App.CreateItemFromTemplate(Template)

'rest of code is here
End Sub

And GenerateEmail() is fired from a button on the ribbon. I need to detect that the user has changed the default text in the subject and body, and if not, warn that they need to.

I don't want it to do this check for emails composed in the usual way (pressing New Email button), only when GenerateEmail() is used, or only when Email Template.oft is used.

Off the top of my head, I could create a custom send button, but would like to avoid that if I can!

Thanks

[skatonni]

I do not think you can know the mail is from a template. Try this.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
    If TypeOf Item Is mailitem Then
   
        Verify_Default_Change Item, Cancel
        If Cancel = True Then Exit Sub
 
    End If
 
End Sub
 
Sub Verify_Default_Change(Item, Cancel)
   
    Dim msg As String
   
     If InStr(Item.Subject, "Unique subject placeholder") Then
        msg = "You have forgotten to replace ""Unique subject placeholder"""
        Cancel = True
    End If
   
    If InStr(Item.body, "Unique text placeholder") Then
        msg = msg & vbCr & "You have forgotten to replace ""Unique text placeholder"""
        Cancel = True
    End If
       
    If Cancel = True Then MsgBox msg
   
End Sub

[ldoodle]

Thanks. That's not a million miles from what I ended up doing.

If Item.Class = olMail Then

    Set d = New Dictionary
    
    With Item
    
        .BodyFormat = olFormatHTML
    
        If Left(.Subject, 5) = "#####" Then
        
            If InStr(1, .Subject, "[Brief description]") Then
            
                d.Add 1, "[Brief description] in the subject"
            
            End If
            
            If InStr(1, .Subject, "[Date]") Then
            
                d.Add 2, "[Date] in the subject"
            
            End If
            
            If InStr(1, .HTMLBody, "[Brief description]") Then
            
                d.Add 3, "[Brief description] in the body"
            
            End If
        
        End If
        
        If d.Count > 0 Then
        
            MsgBox "Please fix the following errors:" & vbNewLine & vbNewLine & Join(d.Items, vbNewLine), vbOKOnly + vbExclamation, "Errors were encountered"
            Cancel = True
        
        Else
        
            .Subject = Replace(.Subject, "#####", "")
            Cancel = False
        
        End If
        
    End With
    
    Set d = Nothing


End If

[ldoodle]

Can someone help me understand ThisOutlookSession and Class modules?

The code I've written, works fine if it's all in ThisOutlookSession, but the code is getting quite large now so I want to try and break it out in to multiple Class modules.

I basically have both ItemSend and ItemAdd events, and none of these fire if I put them in Class module.

I think the problem is Initialize_handler are never being fired, but I'm not sure how best to accomplish that.

On ItemSend, as above I am detecting unchanged fields from an OFT file. And on ItemAdd, I am saving the sent email to a Windows folder.

Class1 module (ItemSend):

Option Explicit

Public WithEvents App As Outlook.Application


Public Sub Initialize_handler()


    Set App = CreateObject("Outlook.Application")


End Sub


Private Sub App_ItemSend(ByVal Item As Object, Cancel As Boolean)


    ' do something here


End Sub

Class2 module (ItemAdd):

Option Explicit

Dim App As New Outlook.Application
Private WithEvents SentItems As Outlook.Items


Public Sub Initialize_handler()


    Set SentItems = App.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail).Items


End Sub


Private Sub SentItems_ItemAdd(ByVal Item As Object)


    'do something here too


End Sub

Module2 module (GenerateEmail) - stripped out to keep it short:

Option Explicit

Public Entity As String
Public IRNs() As String


Public Sub NewClientEmail()


    Entity = "I"
    GenerateEmail (Entity)


End Sub


Public Sub NewAgentEmail()


    Entity = "A"
    GenerateEmail (Entity)


End Sub


Private Sub GenerateEmail(Entity As String)


    Dim App As Outlook.Application
    Dim Item As Outlook.MailItem
    Dim Connection, Command, Recordset As Object
    Dim InputIRNs, Rows As Variant
    Dim SqlCon, InputIRN, Client, Country As String
    Dim IRNsWithStaff(), ClientRefs(), AppNos() As String
    Dim d As Dictionary
    Dim i, r, dCount As Integer
    
    Set App = New Class1
    App.Initialize_handler
    
    Set Item = App.CreateItemFromTemplate(Template(Entity))
    
    With Item
    
        'do something
    
    End With
    
End Sub

The App.CreateItemFromTemplate line (highlighted) fails, because CreateItemFromTemplate does not exist in App, even though App is from Outlook.Application from Class1 module.

[skatonni]

I think the problem is Initialize_handler are never being fired, but I'm not sure how best to accomplish that.

Change the two Initialize_handler names so they are different. Move them to a regular module not a class module.

In ThisOutlookSession

Sub Application_Startup()
 
    Initialize_handler_1
    Initialize_handler_2

End Sub