Auto Insert Current Date or Time into Email Subject

[PJM]

Hello,
I'm looking to have some VBA code to auto-insert the current date every time I click new email.
I was able to figure out the code to run as a Macro of how I want it to work (adapted from your code )but can't figure out how to automate it. Help Please

Sub AddDatetoSubject()
Dim myolApp As Outlook.Application
Dim aItem As MailItem ' Object

Set myolApp = CreateObject("Outlook.Application")
Set mail = myolApp.ActiveExplorer.CurrentFolder

Dim iItemsUpdated As Integer
Dim strTemp As String
Dim strDate As String

iItemsUpdated = 0
For Each aItem In mail.Items
Debug.Print aItem.ConversationTopic
strDate = Format(aItem.ReceivedTime, "yy-mm-dd")
strTemp = strDate & " " & aItem.Subject
aItem.Subject = strTemp
iItemsUpdated = iItemsUpdated + 1
aItem.Save
Next aItem

MsgBox iItemsUpdated & " of " & mail.Items.Count & " Messages Updated"
Set myolApp = Nothing
End Sub

 

[Diane Poremsky]

you need to use activeinstpector. I pulled this from

Changing the font in Outlook's Notes field

How to change the font in the Notes field of Appointments, Contacts, and Tasks, but not in Email bodies using VBA. I'll show you how.

www.slipstick.com

Are you adding it to the subject or body?

Not tested so it might have a typo or bug or two....

Private WithEvents m_Inspectors As Outlook.Inspectors
Private WithEvents m_Inspector As Outlook.Inspector
 '//slipstick.me/888jf
Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
  Set m_Inspector = Inspector
End Sub


Private Sub m_Inspector_Activate()
 
' skip calendar and contacts
If m_Inspector.CurrentItem.Class = olAppointment Or m_Inspector.CurrentItem.Class = olContact Then
    Exit Sub
Else

' use this to format or if you want short date format, just use Date where you want the date
 strDate = Format(date, "yy-mm-dd") 
'

' subject

 m_Inspector.subject =  strDate
'm_Inspector.subject =  Date

' can either use word or a simple .body command to 
' insert in body
Dim olInspector As Outlook.Inspector
Dim olDocument As Word.Document
Dim olSelection As Word.Selection

Set olInspector = Application.ActiveInspector()
Set olDocument = olInspector.WordEditor
Set olSelection = olDocument.Application.Selection

olSelection.InsertBefore strDate
' olSelection.InsertBefore Date
 Set m_Inspector = Nothing
 
End Sub

 

[PJM]

Thanks so much! I almost have the code completed. This is what I have in the ThisOutlookSession code area.
There are two issues I was hoping for any help
1)I want this code to run any time I create a new message. Currently, I have to run the macro and then click new email for it to run. I'd prefer have it run automatically every time I clock new email.
2)I'm hoping that when solving #1, it solves the issue that I have when I open .msg files that we have stored on our local drive, this macro runs. I believe it's running because it runs every time I open a message instead of only on new messages.


Public WithEvents objInspectors As Inspectors
Public WithEvents objMail As MailItem

Public Sub Initialize_handlers()
Set objInspectors = Application.Inspectors
End Sub

Public Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If TypeOf Inspector.CurrentItem Is MailItem Then
Set objMail = Inspector.CurrentItem
End If
End Sub

Public Sub objMail_Open(Cancel As Boolean)
Dim strDate As String

'the current date

strDate = Format(Date, "yy mm dd")
UserForm1.Show

' MsgBox "user chose " & lstNo & " from combo"

Select Case lstNo
Case -1
objMail.Subject = strDate & " "
Case 0
objMail.Subject = strDate & " West1 "
Case 1
objMail.Subject = strDate & " Charlotte "
Case 2
objMail.Subject = strDate & " "
Case 3
objMail.Subject = "Subject 4"
Case 4
objMail.Subject = "Subject 5"
End Select


End Sub