I autofoward all messages in a folder that I ran this macro on. I upgraded yesterday to 2013 and it does not work. I searched the commands used and couldn't find any of the ones I'm using not being recognized in Outlook 2013.
Sub ChangeSubjectForward(Item As Outlook.MailItem)
Item.Subject = "TAG NUMBER1234" & Item.Subject
Item.Save
Set myForward = Item.Forward
myForward.Recipients.Add "Email#email.com"
myForward.Send
End Sub
Your code looks good, I don't see anything strange in the code. It looks like you need to create a rule and assign the VBA macro sub to run.
Some Questions:
What are your rule settings that run this?
Are you manually running the rule on the folder, or is the rule automatically running on a trigger?
Are you getting any error messages?
Try the following:
Make sure the rule that runs your autoforward macro is lower on the rule list than the rule that files messages in that subfolder (if you're using one).
Also, since I don't know what triggers your macro, exactly, it's possible it is stopping when it is encountering a non MailItem object. Try this change:
Sub ChangeSubjectForward(olObj As Object)
dim Item As Outlook.MailItem
If olObj.Class <> olMail Then 'Making sure it is an email message
msgbox("Object Was Not MailItem")
Exit Sub
End If
Set Item = olObj
Item.Subject = "TAG NUMBER1234" & Item.Subject
Item.Save
Set myForward = Item.Forward
myForward.Recipients.Add "Email#email.com"
myForward.Send
End Sub
If you keep getting the message "Object Was Not MailItem" then the wrong objects are getting passed to your sub.
Related
I'm trying to use Outlook VBA to check all my emails on startup, and whenever I receive a new email, to see if the email subject is "Sample Daily Data Pull". If the email subject matches, I want outlook to save the attachment to a specified network drive folder. Here is the code I have:
In "ThisOutlookSession"
Option Explicit
Private WithEvents inboxItems As Outlook.Items
Private Sub Application_Startup()
Dim outlookApp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookApp = Outlook.Application
Set objectNS = outlookApp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Dim Msg As Outlook.MailItem
If TypeName(Item) = "MailItem" Then
If Item.Subject = "Sample Daily Data Pull" Then
Call SaveAttachmentsToDisk
Else
End If
End If
End Sub
I also have the following code in a module:
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "N:\SampleFilePath\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub
This is my first time working in Outlook VBA, so my apologies if it's something very basic and obvious. Not really sure what is going wrong as I'm not getting any error messages. All I know is that the the macro is not saving attachments on my network drive as it should be.
Thanks in advance for any help.
Your code does not work for me because of:
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
Outlook saves mail items, calendar items, tasks and other such information in files it calls Stores. You can have several stores each of which will have an Inbox. I am a home user with two email accounts. I did a default installation of Outlook then used a wizard to add an account for each of my email addresses. The result is I had three stores:
Outlook Data File
MyName#myisp.com
MyName#gmail.com
“Outlook Data File” is the default store and contains the default Inbox but new emails are placed in the Inboxes in the other two stores. To test if you have the same problem, open Outlook, open the VBA Editor, type the following into your Immediate Window and press [Return].
? Session.GetDefaultFolder(olFolderInbox).Parent.Name
On my system, this statement outputs “Outlook Data File” because that store contains the default Inbox. If I want to have an event handler for new emails I need to have:
Private Sub Application_Startup()
Set InboxItems = Session.Folders("MyName#myisp.com").Folders("Inbox").Items
End Sub
This is someone shorter than your macro, which I will explain later, but the key difference is I am naming the Inbox I wish to monitor. If the Inbox that receives your new emails is not Outlook’s default Inbox, you will have to name the folder containing the Inbox you wish to monitor.
Why is my macro so much shorter than yours?
Dim outlookApp As Outlook.Application
Set outlookApp = Outlook.Application
You are already within Outlook so these statements are redundant.
You could replace:
Set objectNS = outlookApp.GetNamespace("MAPI")
by
Set objectNS = Application.GetNamespace("MAPI")
But you do not have to. The only GetNamespace is under Application so the qualification is optional. The only qualification that I know to be non-optional is Outlook.Folder and Scripting.Folder. If you write Folder within Outlook it assumes you want one of its folders. If you want to refer to a disk folder you must say so.
You have:
Dim objectNS As Outlook.NameSpace
Set objectNS = outlookApp.GetNamespace("MAPI")
I have used Session. The documentation states that Namespace and Session are identical. I prefer Session but most people seem to prefer Namespace. Your choice.
If you are references the correct Inbox, we need to look further for the cause of your problem.
The next possible issue is If Item.Subject = "Sample Daily Data Pull". This requires Item.Subject be exactly equal to "Sample Daily Data Pull". An extra space or a lower case letter and they are not equal.
Next, I suggest adding a statement at the top of each of procedure to give:
Private Sub Application_Startup()
Debug.Assert False
: : :
Private Sub inboxItems_ItemAdd(ByVal Item As Object)
Debug.Assert False
: : :
Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Debug.Assert False
: : :
Many programming languages have an Assertion statement; this is VBA’s version. It allows the programmer to assert that something will be true. Execution will stop if the assertion is false. I find Debug.Assert False invaluable during testing. Debug.Assert False will always be false so execution will always stop. This is an easy way to test that Application_Startup, inboxItems_ItemAdd and SaveAttachmentsToDisk are being executed.
Try the above suggestions. If they fail to find a problem, we will have to try something else.
Error Handling
In your original posting, you had:
On Error GoTo ErrorHandler
: : :
: : :
ExitNewItem:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
You will often see code like this but I have never seen a justification for it.
If an error occurs during development, this code will result in the error number and description being displayed and the routine exited. How is this helpful? It leaves you to guess from the error description which statement failed. If you omit all the error code, execution stops on the faulty statement. There is no guessing as to which statement was in error. If you can fix the error, you can click F5 and restart with the previously faulty statement. Even if you cannot fix and restart, you have a better understanding of the situation.
For a live system, I have difficulty in imagining anything less user friendly than an error resulting in display of a cryptic error message and the macro terminating.
For a live system, you want something like:
Dim ErrNum As Long
Dim ErrDesc As String
On Error Resume Next
Statement that might fail
ErrNum = Err.Num
ErrDesc = Err.Description
On Error GoTo 0
If ErrNum > 0 Then
' For each possible value for ErrNum, code to provide user friendly
' description of what has gone wrong and how to fix it.
End If
VBA is not the ideal language for writing code that fails gracefully but with care you can create some very acceptable error handling code.
I am trying to change incoming emails subject line to only the last 11 characters of the subject line. When I use Item.Subject = Right(Item.Subject,11) it does not work.
Can someone assist?
Full code.
Sub ChangeSubjectForward(Item As Outlook.MailItem)
Item.Subject = Right(Item.Subject, 11)
Item.Save
End Sub
You could create a macro rule then run the below code:
Sub save_to_dir_test1(mymail As MailItem)
Dim strID As String
Dim objMail As Outlook.MailItem
strID = mymail.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
objMail.Subject = Right(m.Subject, 11)
objMail.Save
Set objMail = Nothing
End Sub
For more information, please refer to this link:
Run a Script Rule: Change Subject then Forward Message
Getting the incoming email in outlook via VBA
I found another SO thread that says you can't modify the subject of a message without opening it first. We can use ActiveInspector to get a handle on the Item after we display it. Then we can change it, save it, and close it. I added a check to see if the subject is actually longer than 11 characters before we attempt to truncate it.
Try this:
Public Sub ChangeSubjectForward(ByRef Item As Outlook.MailItem)
Debug.Print Now ' This shows you when the code runs
If Len(Item.Subject) > 11 Then
Debug.Print "Subject is too long. Trimming..." ' This shows that we tried to truncate.
Item.Display 'Force the pop-up
Dim thisInspector As Inspector
Set thisInspector = Application.ActiveInspector
Set Item = thisInspector.CurrentItem ' Get the handle from the Inspector
Item.Subject = Right$(Item.Subject, 11)
Item.Save
Item.Close
End If
End Sub
I've code in the "ThisOutlookSession" module.
Application_ItemSend works, events are triggered when sending mail.
Application_Startup runs when I initiate it manually after Outlook has been opened - not upon startup.
Making the sub private makes no difference - neither does making the variables public.
I have macro settings on "Enable all macros" in the Trust Center.
I'm on Outlook 2016 on a PC running Windows 10 Enterprise.
I have researched the issue intensively.
Option Explicit
Dim add_str As String
Public Sub Application_Startup()
Dim olNs As Outlook.NameSpace
Dim Folder As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim Item As Object
Set olNs = Application.GetNamespace("MAPI")
Set Folder = olNs.Folders("albrobin#workmail.com").Folders("WORKFLOW").Folders("Reporting")
For Each SubFolder In Folder.Folders
If SubFolder.items.Restrict("[UnRead] = True").Count > 0 Then
For Each Item In SubFolder.items
Item.UnRead = False
Next
End If
Next
End Sub
Public Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
If TypeName(Item) <> "MailItem" Then
Exit Sub
End If
If Item.Subject Like "RE: *" _
Or Item.Subject Like "AW: *" _
Or Item.Subject Like "FW: *" Then
Exit Sub
End If
UserForm1.Show
If add_str = "[URGENT] " Then
Item.Importance = olImportanceHigh
End If
Item.Subject = add_str & Item.Subject
add_str = vbNullString
End Sub
Public Sub routine(str_ As String)
add_str = Replace(str_, vbCrLf, " ")
add_str = "[" & add_str & "] "
End Sub
Sub show_form1()
UserForm1.Show
End Sub
I tested your code and I’ve ran into the same problem.
I have solved this problem by restarting my PC and adding the Public Sub Application_Quit() method.
There seems to be a flag in outlook which checks for VBA code. If it can't find any it sets the registry value (HKEY_CURRENT_USER\Software\Microsoft\Office\XX.0\Outlook\LoadMacroProviderOnBoot) to 0 every time it closes. It doesn't seem to be setup so that it detects when code is added by copying the OTM file.
I have discovered 2 scenarios (there may be more) which cause the flag to be set causing outlook to change the registry value to 1 on close.
If any macro is run
The visual basic editor is opened.
The issue arose in my situation when I try to roll out the VBA code to a new PC with no existing VBA code.
I use a batch script to roll out my VBA code to other machines and to fix it I simply added a REG ADD command to the bat file after the code is copied to the machine which sets the key to 1.
REG ADD HKCU\Software\Microsoft\Office\XX.0\Outlook /v LoadMacroProviderOnBoot /t REG_DWORD /d 1 /f
You need to change “XX.0” to the version of office you are dealing with. Check the registry to find out.
This seems to force Outlook to check for VBA code when it starts.
(Thanks to Sergik718 on Microsoft TechNet forums for pointing out that changing this registry entry helps.)
Was experiencing same problem with Application_Startup() procedure not firing after a system reload and restore of my VBAProject. Checked macro settings, digitally signed the project - no luck. Received no button to Enable VBA during startup, like in Office 2010. VBA would function, but required me to manually fire the Application_Startup() procedure.
Tried creating a new, temporary "Private Application_Startup()" procedure, but no joy.
I deleted "Public" statement that preceded the Application_Startup() declaration. Saved, closed VBA and Outlook. Re-opened and suddenly it started working. Have restored the "Public", saved, re-opened, and it now seems to work properly. No explanation.
Had a similar problem. Application_Startup didn't trigger on restarting Outlook and hence my changes in the function didn't load. The reason Application_Startup didn't trigger was because I had another program holding a reference open to Outlook
I use a outlook rule to process incoming mail via a VBA macro.
in the vba various actions are triggerd to process attachments of the incoming mail.
The problem is, there somethimes is a stack of e-mails that need to be processed.
I cant seem to find a way how to trigger the one by one.
I want to wait a few seconds before processing the next mail, if there is a stack.
Putting a sleep method in the macro doesnt seem to have effect. the rule doesnt seem to wait for the previous message to be done.
My method i something like:
Is there a way to accomplish this behaviour?
Private Sub ProcessMail(ByVal Item As Object)
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
If TypeOf Item Is Outlook.MailItem Then
Dim Msg As Outlook.MailItem
DoProcessingMethod
End If
End If
End Sub
Putting a wait or sleep in the method doesnt cause it to be processed one by one.
GD Arnold,
You could indeed use the ItemAdd option as per #Brett's answer.
I use a similar process to automatically upload received data (as attachment in an email) and upload this to a MySQL database. The action is triggered by the ItemAdd method and mails are checked one-by-one.
Simplified instructions:
Add a Class to your VBA code named "EventClassModule"
In your class, type
Public WithEvents dItems As Outlook.Items
In your ThisOutlookSession make a sub that registers the event_handler:
Sub Register_Event_Handler()
Set myClass.dItems = Outlook.Items
End Sub
In your ThisOutlookSession make a sub that handles the ItemAdd event as below:
Private Sub dItems_ItemAdd(ByVal newItem As Object)
On Error GoTo ErrorHandler
Dim msg As Outlook.MailItem
If newItem.Class = olMail Then
Set msg = newItem
'Do something with the msg item, check rules, check subject, check whatever
'This will process messages when the arrive in your mailbox one by one.
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
These steps should provide you with a sub that is triggered when a new mail arrives.
You could then call a function/sub like below.
The below sub runs all rules based on an optional ruleSet variable, it checks the rule.Name against the ruleSet and if the ruleSet string exists in the rule.Name then it executes some code. This way you can have multiple rules and only execute some of them based on which 'ruleSet' they are part of. You can define that by altering their name.
It's a refinement of the 'Run Rules' option in Outlook.
Some of this code came frome here: Setting VBA to read personal inbox
Sub runRules(Optional ruleSet As String)
Dim olStore As Outlook.Store
Dim myRules As Outlook.Rules
Dim tmpInbox As Outlook.Folder
Dim tmpSent As Outlook.Folder
Dim rl As Outlook.Rule
'On Error Resume Next
'toTmpBox (ruleSet)
' get default store (where rules live)
Set olStore = Application.Session.DefaultStore
With olStore
Set tmpInbox = .GetDefaultFolder(olFolderInbox) '.Folders("tmpInbox")
Set tmpSent = .GetDefaultFolder(olFolderSentMail) '.Folders("tmpSentBox")
End With
' get rules
Set myRules = olStore.GetRules
' iterate through all the rules
For Each rl In myRules
Debug.Print rl.Conditions.Body.Enabled & " " & rl.Conditions.Body.Text
If InStr(LCase(rl.Name), ruleSet) > 0 And (rl.Enabled) Then
rl.Execute ShowProgress:=True, Folder:=tmpInbox
If ruleSet = "autorun" Then
rl.Execute ShowProgress:=True, Folder:=olStore.GetDefaultFolder(olFolderSentMail)
End If
ruleList = ruleList & vbCrLf & rl.Name
End If
Next
' tell the user what you did
ruleList = "These rules were executed " & _
vbCrLf & ruleList
MsgBox ruleList, vbInformation, "Macro: RunMyRules"
CleanUp:
Set olStore = Nothing
Set tmpInbox = Nothing
Set tmpSent = Nothing
Set rl = Nothing
Set myRules = Nothing
End Sub
I have come across a similar problem. In my case my tool would run at regular time interval and each time I had to capture new emails only. Now new emails could be one or multiple. the solution I found was as given below.
Each time the tool would run. it will capture the new emails and just mark a simple ',' or '|' anything of your choice at the end of the subject in such a way that no one will notice. Now next time when the tool runs it checks if the emails received for the entire day or two (based on your requirements) has those markers or not.
This solution works if the email communication is one way. If we use these email for chain emails then their is another solution.
Here you will have to save the time max time of emails captured in the last run. Now each time you run you just have to run it for the entire day and put an if statement that is should be greater then time last captured.
Now to store the max time you might need to create a folder and an email. The email can help you to store the each time the run happens
item.subject = maxtime
item.save
I'm trying to debug an Outlook 2007 VBA script that's fired by a rule. I've set a breakpoint in the script but it doesn't get hit.
The script is actually a Sub in the ThisOutlookSession object.
When I run the rule on a specified folder nothing seems to happen.
What am I doing wrong?
Update:
I've added a MsgBox "Processing: " & mailItem.Subject to the script and that pops up just fine when I run the rule. However I can't seem to get the script to stop on breakpoints.
I think you may not be doing anything wrong, because I have experienced exactly the same behaviour.
However, in order to debug your VBA, I suggest that you create a macro (via the Tools|Macro|Macros menu) that calls your script function with a test e-mail item that you create in the macro.
Maybe something like this:
Sub TestScript()
Dim testMail As MailItem
Set testMail = Application.CreateItem(olMailItem)
testMail.Subject = "Test subject"
testMail.Body = "Test body"
Project1.ThisOutlookSession.YourScriptForDebugging testMail
End Sub
This way you can "Step Into" the macro via that Macro dialog again, and do all the debugging you need. It solved my problem, anyway.
Any existing item can be used to test code that requires one.
Sub passOpenItem()
'first open an item
codeRequiringItemParameter ActiveInspector.CurrentItem
End Sub
Sub passSeletion()
'first select an item
codeRequiringItemParameter ActiveExplorer.Selection(1)
End Sub
Sub codeRequiringItemParameter(itm As Object)
Debug.Print "TypeName: " & TypeName(itm)
Debug.Print "Class...: " & itm.Class
End Sub