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