I found this code online. It is supposed to auto populate my subject line with any attachments I provide. The code does not run.
I don't receive an error or anything that suggests its even going through the code.
Public WithEvents olInspectors As Outlook.Inspectors
Public WithEvents olMail As Outlook.MailItem
Private Sub Initialize_handlers()
Set olInspectors = Application.Inspectors
End Sub
Private Sub olInspectors_NewInspector(ByVal Inspector As Inspector)
Dim olItem As Object
Set olItem = Inspector.CurrentItem
If TypeName(olItem) = "MailItem" Then Set olMail = olItem
End Sub
Private Sub olMail_AttachmentAdd(ByVal Attachment As Attachment)
MsgBox "This is a test."
If olMail.Subject = "" Then
'If you don't want the prompt,
'Just delete the Msgbox line and its corresponding "End if".
If MsgBox("Do you want to use the attachment name as the subject", vbYesNo) = vbYes Then
olMail.Subject = Attachment.DisplayName
End If
End If
End Sub
There is nothing wrong with your code, you simply need to Initialize the Inspectors
Click on Sub Initialize_handlers() and press F5
Private Sub Initialize_handlers()
Set olInspectors = Application.Inspectors
End Sub
Or just use Application.Startup Event (Outlook), Save it and restart Outlook then it should work
Example
Public WithEvents olInspectors As Outlook.Inspectors
Public WithEvents olMail As Outlook.mailitem
Private Sub Application_Startup()
Set olInspectors = Application.Inspectors
End Sub
Private Sub Initialize_handlers()
Set olInspectors = Application.Inspectors
End Sub
Private Sub olInspectors_NewInspector(ByVal Inspector As Inspector)
Dim olItem As Object
Set olItem = Inspector.CurrentItem
If TypeName(olItem) = "MailItem" Then Set olMail = olItem
End Sub
Private Sub olMail_AttachmentAdd(ByVal Attachment As Attachment)
MsgBox "This is a test."
If olMail.Subject = "" Then
'If you don't want the prompt,
'Just delete the Msgbox line and its corresponding "End if".
If MsgBox("Do you want to use the attachment name as the subject", _
vbYesNo) = vbYes Then
olMail.Subject = Attachment.DisplayName
End If
End If
End Sub
Related
I am trying to auto forward an email from a specific sender and with a specific subject to a list of new recipients.
When I create a Run a Script Rule, my script is not shown.
Add my script via VBA Editor
Rules > Manage Rules & Alerts > Run a script
Select Run a script action -> Can not Select my script (script not show)
Option Explicit
Public WithEvents objInbox As Outlook.Folder
Public WithEvents objInboxItems As Outlook.Items
Private Sub Application_Startup()
Set objInbox = Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
Set objInboxItems = objInbox.Items
End Sub
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
Dim xStr1 As String
Dim xStr2 As String
If TypeOf Item Is MailItem Then
Set objMail = Item
If (objMail.SenderEmailAddress = "T#com") And (objMail.Subject = "ZZZZZ") Then
Set objForward = objMail.Forward
GoTo commonOutput
End If
End If
Exit Sub
commonOutput:
With objForward
.HTMLBody = xStr1 & xStr2 & Item.HTMLBody
.Display
End With
Release:
Set myFwd = Nothing
End Sub
VBA script which can be assigned to a rule should have the following signature:
Public Sub Test(item as object)
' your code
End Sub
Your existing code does almost the same without rules. It handles the ItemAdd event for the Inbox folder, so you just need to replace the Display method call with Send:
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
Dim objMail As Outlook.MailItem
Dim objForward As Outlook.MailItem
Dim xStr1 As String
Dim xStr2 As String
If TypeOf Item Is MailItem Then
Set objMail = Item
If (objMail.SenderEmailAddress = "T#com") And (objMail.Subject = "ZZZZZ") Then
Set objForward = objMail.Forward
GoTo commonOutput
End If
End If
Exit Sub
commonOutput:
With objForward
.HTMLBody = xStr1 & xStr2 & Item.HTMLBody
.Send
End With
Release:
Set myFwd = Nothing
End Sub
How would I modify the following code to trigger the event myMailItem_ItemSend only when the email is sent by myMacro1, but not in other cases (such as myMacro2)?
The event should be triggered especially for those macros using the myMailItem object.
Public WithEvents myMailItem As Outlook.MailItem
Public Sub Initialize_handler()
Set myMailItem = Outlook.MailItem
End Sub
Private Sub myMailItem_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Send confirmation") = vbNo Then
Cancel = True
End If
End Sub
'Should trigger the send confirmation msgbox
Private Sub myMacro1()
Dim objApp As Outlook.Application
Set objApp = Application
Set myMailItem = objApp.ActiveInspector.CurrentItem.ReplyAll
myMailItem.Display
End Sub
'Should NOT trigger the send confirmation msgbox
Private Sub myMacro2()
Dim objApp As Outlook.Application
Set objApp = Application
Dim oEmail As Outlook.mailItem
Set oEmail = objApp.ActiveInspector.CurrentItem.ReplyAll
oEmail.Display
End Sub
Your kind help would be appreciated.
I would go for this:
Define a global variable in your module, such as Dim TriggerMsgBox As Boolean. By default, the variable will be false.
Initialize it as True in the myMacro1(). Only in that case, it will become True. Else, it will be False.
Use it in the myMailItem_ItemSend event: if the variable is True (meaning we just passed by myMacro1()), then you need to prompt the MsgBox. Else, you will just pass by. Of course, don't forget to reset the variable to False after the MsgBox is hit, else you will keep on showing it even later.
In your code it would be:
Public WithEvents myMailItem As Outlook.MailItem
Dim TriggerMsgBox As Boolean '<-- NEW LINE OF CODE
Public Sub Initialize_handler()
Set myMailItem = Outlook.MailItem
End Sub
Private Sub myMailItem_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
If TriggerMsgBox Then '<-- NEW LINE OF CODE
TriggerMsgBox = False '<-- NEW LINE OF CODE
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Send confirmation") = vbNo Then
Cancel = True
End If
End If '<-- NEW LINE OF CODE
End Sub
'Should trigger the send confirmation msgbox
Private Sub myMacro1()
Dim objApp As Outlook.Application
Set objApp = Application
Set myMailItem = objApp.ActiveInspector.CurrentItem.ReplyAll
TriggerMsgBox = True '<-- NEW LINE OF CODE
myMailItem.Display
End Sub
'Should NOT trigger the send confirmation msgbox
Private Sub myMacro2()
Dim objApp As Outlook.Application
Set objApp = Application
Dim oEmail As Outlook.mailItem
Set oEmail = objApp.ActiveInspector.CurrentItem.ReplyAll
oEmail.Display
End Sub
My code looks like this:
Public WithEvents myItem As Outlook.MailItem
Private Sub Application_ItemLoad(ByVal Item As Object)
If Item.Class = olMail Then
Set myItem = Item
End If
End Sub
Private Sub myItem_Open(Cancel As Boolean)
Dim oAccount As Outlook.Explorer
Dim oMail As MailItem
Dim Recip As Outlook.Recipient
Set oAccount = Application.ActiveExplorer
MsgBox (oAccount.CurrentFolder.Store)
If oAccount.CurrentFolder.Store = "1#2.com" Then
MsgBox ("CC needs to be added")
Set Recip = myItem.Recipients.Add("user#test.com")
Recip.Type = olBCC
Else
MsgBox ("no need to add CC")
End If
End Sub
The part responsible for adding user#test.com to the CC field is adding that address to the "To:" field instead.
i just had to add Recip.Resolve after Recip.Type = olCC. That solved the issue.
Private WithEvents Items As Outlook.Items
Public MyTrueFalse As Boolean
Private Sub Application_Startup()
Dim MyTrueFalse As Boolean 'Redundant?'
MyTrueFalse = True 'Defaults to False'
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object, ByVal MyTrueFalse As Boolean)
If MyTrueFalse Then GoTo DoThisAlso 'Example Only'
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
DoThisAlso:
MsgBox "MyTrueFalse is: " & MyTrueFalse
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
I am using the code above and its working wonderfully on the NEW EMAIL trigger (THANK YOU - Gautam Mainkar (LINK). However, I am trying to pass a Boolean (True/False) variable along with the Items event trigger.
So I am attempting to set say...MyTrueFalse within the Application_Startup() so it is set ONLY ONCE, and passed whenever Items_ItemAdd is triggered by a new email.
I do not want another sub routine, just pass MyTrueFalse boolean as set in the Application_Startup().
I have tried multiple variations of Public settings and multiple variables on the Items_ItemAdd sub and nothing works. I am hoping someone can help me here. Thanks
Oh Yeah: it resides in ThisOutlookSession
Private WithEvents Items As Outlook.Items
Private MyTrueFalse As Boolean
Private Sub Application_Startup()
MyTrueFalse = True
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
If MyTrueFalse Then GoTo DoThisAlso 'Example Only'
On Error Goto ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
' do something here
' ******************
End If
DoThisAlso:
MsgBox "MyTrueFalse is: " & MyTrueFalse
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Tim Williams was right, corrected the code (above) and works great!! Thanks Tim. Mike
I have the following code which tells when new message has arrived!
Private Sub Application_NewMail()
MsgBox "New Mail Has Arrived"
End Sub
How do I read the body,subject of this mail? Are there any good tutorials for outlook programming?
I found msdn tutorial which was useful but was general overview.
You'll need something like this:
Private WithEvents myOlItems As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set myOlItems = objNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
MsgBox Msg.Subject
MsgBox Msg.Body
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Paste the code into ThisOutlookSession and restart Outlook. When a message enters your default local Inbox you'll see the popup with subject and body.