I'm trying to write a fairly simple macro that will add the received date to the subject line of an email. I've compiled the code below and it works for a single e-mail. However, it appears the For Each loop ends after the first email, and I'm at a total loss on how to solve this. I've tried changing the the PickFolder line with an ActiveExplorer.Selection line - exactly the same problem.
Sub SelectedMailItemsSubjectWithDate()
Dim objMainFolder As Outlook.Folder
Dim MObj As Outlook.MailItem
Set objMainFolder = Outlook.Application.Session.PickFolder
For Each MObj In objMainFolder.Items
'Adds the date to the subject
MObj.Subject = Format(MObj.ReceivedTime, "YYYYMMDD") & " - " & MObj.Subject
Next MObj
End Sub
Is there anyone who can help me with this? I would be much obliged!
The reason I'm trying to add the date is that we will need to archive thousands of e-mail in the .msg format, in an online storage that doesn't show anything except the subject line of the file.
Wait a sec, how do you know only one item is processed? Are you stepping through your code and see that the loop exits prematurely? Or that only one item is modified? In the latter case you need to save the item:
MObj.Subject = Format(MObj.ReceivedTime, "YYYYMMDD") & " - " & MObj.Subject
MObj.Save
Declare MObj as a generic Object rather than Outlook.MailItem - you can have other items in a folder, such as ReportItem, MeetingItem, etc.
Related
Company i work for manually saves certain requests (sent per mail) to a shared drive, renaming them as such: "YYYYMMDD_Firstname_Lastname". The mails are saved as .msg
Since we get about a hundred of these per week, I'd like to macro this so I don't waste time.
The article here: Outlook VBA macro for saving emails copies in a local folder explains how to save files locally, but I'd like to make following additions:
- Rename the copy before it gets saved to the shared drive (manually if needed)
- Select the shared path it needs to be saved to (preferably a drop-down with three choices)
- create a proper userform for this
If anyone could assist with the code, or provide me with tutorials/guides on how to do this myself, I'd be extremely grateful.
P.S. just started using and creating macro's a week ago. Still very much a beginner. any link to a good tutorial for developers would be greatly appreciated, regardless of whether it answers my questions.
Thanks guys!
Used the code described in the article as such:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Call SaveACopy(Item)
End Sub
Sub SaveACopy(Item As Object)
Const olMsg As Long = 3
Dim m As MailItem
Dim savePath As String
If TypeName(Item) <> "MailItem" Then Exit Sub
Set m = Item
savePath = "c:\users\your_user_name\desktop\" '## Modify as needed
savePath = savePath & m.Subject & Format(Now(), "yyyy-mm-dd-hhNNss")
savePath = savePath & ".msg"
m.SaveAs savePath, olMsg
End Sub
Update: using the macro provided by Tony Dallimore I've amanaged to identify that .SenderName is the main info I need from the mails to be processed. All I need now is to replace the spaces in that output by underscores, and add the date in reverse in front of it to have my filename.
Thanks a bunch to Tony Dallimore for the continuous assistance on this project.
Since it seems somewhat confusing looking back on my original question, I'll try to clarify:
I get about 100 mails a week informing us of approvals of certain user requests.
Company policy is to save these mails as .msg on a shared drive used for administration before processing the request. The filename of these messages needs to be as such:
"YYYYMMDD_FIRSTNAME_LASTNAME.msg" (with YYYY being the year, MM being the month, and DD being the day on which we received these mails)
We get three main "types" of such mails, saved in different locations, but using the same filename respectively.
What I'd need is a macro or set of macros that can save these mails in the correct networkdrive under the correct format at the press of a button, or using minimal clicks/manual input.
I've decided to use .SenderName and .Senton, since those seem to give me most of what I need.
This is not a direct answer to your question. It is an investigation which I hope will provide the information necessary for an answer.
You say “… mails are auto-generated by the system …”. This may explain why I do not fully understand why your code works. I will explain my confusion after I have provided some background.
There are four distinct methods by which a MailItem can be selected for processing:
The user can select one or more emails and then call a macro to process the selected MailItem. (Note it is an email to the user but a MailItem to a macro.)
A macro can read up or down a folder of MailItems, reviewing properties to determine which are to be processed. Sort and Filter can be used to more quickly target the MailItems of interest.
You can specify a rule that will look at each email as it arrives and review properties such as subject and sender. If the email has the required properties, a number of actions can be performed. If the standard actions are not adequate, you can link a macro to perform any action available to a VBA macro.
You can instruct Outlook to call a macro whenever a particular event occurs. Events include: MailItem added to folder Xxxx,MailItem opened, MailItemsent, MailItemsaved, MailItem closed, MailItem replied to or MailItem forwarded.
Your code is using approach 4. In particular, you are using a MailItemsent event. You say “ … we get about a hundred of these [emails] per week …”. If “get” is the correct word, I would expect MailItem added to folder Inbox to be the appropriate event. Perhaps your code works because the system is generating emails from user X to user X.
If these emails are generated by the system, we cannot be sure what properties are set and what values they are set to. Please copy the code below to an Outlook module. Select one or more of these emails and run macro CallSubForSelectedEmails.
Option Explicit
Public Sub CallSubForSelectedEmails()
Dim Exp As Explorer
Dim ItemCrnt As MailItem
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select one or more emails then try again", vbOKOnly)
Exit Sub
Else
For Each ItemCrnt In Exp.Selection
If ItemCrnt.Class = olMail Then
Call DsplSimpleProperties(ItemCrnt)
End If
Next
End If
End Sub
Sub DsplSimpleProperties(ItemCrnt As Outlook.MailItem)
Dim InxR As Long
Debug.Print "=============================================="
Debug.Print " Profile: " & Session.CurrentProfileName
Debug.Print " User: " & Session.CurrentUser
With ItemCrnt
Debug.Print " Created: " & .CreationTime
Debug.Print " Receiver: " & .ReceivedByName
Debug.Print " Received: " & .ReceivedTime
For InxR = 1 To .Recipients.Count
Debug.Print "Recipient: " & .Recipients(InxR)
Next
Debug.Print " Sender: " & .Sender
Debug.Print " SenderEA: " & .SenderEmailAddress
Debug.Print " SenderNm: " & .SenderName
Debug.Print " SentOn: " & .SentOn
Debug.Print " Subject: " & .Subject
Debug.Print " To: " & .To
End With
End Sub
For one of my emails, this routine outputs:
==============================================
Profile: Outlook
User: Tony Dallimore
Created: 08/04/2019 19:59:22
Receiver: Tony Dallimore
Received: 08/04/2019 18:45:39
Recipient: a.j.dallimore#acmeisp.com
Sender: Lifecake
SenderEA: support#lifecake.com
SenderNm: Lifecake
SentOn: 08/04/2019 18:45:37
Subject: ?? Someone commented on Alex and Eric's video
To: a.j.dallimore#acmeisp.com
Note 1, I am both the system user and the receiver of this email. This gives two possible ways of getting my first and last names. I use initials in my email address but your company may use names.
Note 2: my code uses approach 1 to select the emails to be processed. Macro CallSubForSelectedEmails calls macro DsplSimpleProperties for each selected email. I do all my investigations and all my development of email processing macros using code like this. This gives me complete control over which emails are processed. The call profile for macro DsplSimpleProperties is the same as that for a rule macro or an event macro. Once I have debugged my macro using approach 1 and switch to calling it from a rule or an event with minimal additional testing. I know of no easier way of debugging email processing macros.
Again this is not a complete answer because I do not have the information for a complete answer.
Task 1: Generate PathName
The information for the path name comes from the MailItem's Subject. For this example, I assume the request type is 1, 2 or 3 and it is the last character of the subject.
Dim PathName As String
' Generate end of subfolder name
Select Case Right$(ItemCrnt.Subject,1)
Case "1"
PathName = "xxxx"
Case "2"
PathName = "yyyy"
Case "3"
PathName = "zzzz"
Case Else
' Subject does not conform to expected format.
Exit Sub
End Select
' Prefix root folder name and year of subfolder name
PathName = "P:\EMEA Requests\" & Year(ItemCrnt.SentOn) & "\" & PathName
Right$ is a function that extracts a specified number of trailing characters from a string. Functions Left$ and Mid$ are also available. If the subject is sufficiently complicated, we can consider Regex. Year is a function that extracts the year from a date. The value will be an integer but VBA will automatically convert it to a string if it used as a string.
If the routine cannot identify the request type, it abandons the MailItem. I will discuss this issue later.
Task 1; Suggestion 2: Generate PathName
You say the subjects lack a fixed format and just include words from the original request. You imply these words are good enough for a human to identify the request type. So the words for a request might include "hardware", "h'ware", "computer" or "laptop". Another request might include "software", "application or "app". This is a simple method of handling this type of situation. There is a better method which I will introduce if this looks feasible.
If Instr(1, LCase(ItemCrnt.Subject), "hardware") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "h'ware") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "computer") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "laptop") <> 0 Then
PathName = "xxxx"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "software") <> 0 Then
PathName = "yyyy"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "application") <> 0 Then
PathName = "yyyy"
ElseIf Instr(1, LCase(ItemCrnt.Subject), "app") <> 0 Then
PathName = "yyyy"
Else
PathName = ""
End If
You can keep adding possible keywords until your requestors run out of alternatives. Failing that you can use your userform with buttons approach after the macro has handled the easy messages.
Task 2: Generate FileName
Dim FileName As String
FileName = Format(ItemCrnt.SentOn, "yymmdd") & " " & Replace(ItemCrnt.SenderName," ", "_")
Task 0: Design
Before coding can start, you need to design the total process. You can start with something simple and then develop it as you better understand your requirement. You can code little bits as I did with PathName and FileName so you can understand the bits you need to fit together. But tackling something complex without a plan rarely ends satisfactorily.
My understanding of your requirement is incomplete but I will have a go at a design.
I would have a Rule that copied incoming emails of this type to an Outlook folder such as "Unsaved EMEA Requests". Note: these are copies; the original remains in the Inbox for processing as required. I assume there is a way to identify these emails that is within the functionality available to a rule.
I would have all the code in a macro which I would call once or twice a day as appropriate. This macro would read up folder "Unsaved EMEA Requests". If it can generate a path and file name for a message, it will save the message to the required disc folder and delete the message from the Outlook folder. If it could not process a message, it would leave it in Outlook folder "Unsaved EMEA Requests". If a message is left in Outlook folder "Unsaved EMEA Requests", you will know (1) that the macro needs enhancing to handle a previously unencountered message type or (2) the rule needs amending because it has copied the wrong sort of message.
I said "read up folder" not "read down folder". You access a MailItem within a folder by its position: 1, 2, 3, … Folder.Count. If you delete MailItem 2 then MailItem 3 becomes MailItem 2, MailItem 4 becomes MailItem 3 and so on. The value of Folder.Count is reduced by one. You sometimes see questions asking why their macro is only processing every other MailItem. The reason is they have coding like:
For InxI = 1 to Folder.Count
' Process and delete Folder.Item(InxI)
Next
With the above code, you process items 1, 2, 3 in turn. If you delete item 2, you will skip the original item 3 because it is now item 2.
The correct code is:
For InxI = Folder.Count To 1 Step -1
' Process and delete Folder.Item(InxI)
Next
With this code you process items 10, 9, 8, 7 in turn. If you delete item 9, you do not care that item 10 has become item 9 because you are now processing item 8.
If you are only reading items, you do not need to worry above this issue. But if you are adding or deleted items, you do need to worry about it.
I receive multiple log files per day and would like to create a rule or vba script that will move the email to a specified folder. The catch is, it should only be moved if it contains specific text in an xml attachment. I'm new to VBA and couldn't find anything that look particularly helpful online, and I couldn't find a way to do it with a rule.
I am able to find the correct files to move if I do a manual search [ext:xml attachment:TestScriptFailed], but I'm not sure how to translate that into a rule or VBA script to automate the transfer process.
You have been a member for 26 months so you should be aware this site is for programmers to help each other develop. You have asked way too much in a single question and have made no obvious attempt to break it down. If someone gave you macro that was almost what you wanted, would you understand it enough to finish it? I will try to get you started.
I know nothing that suggests a rule exists that can test for a particular string within a particular type of attachment and, if found, save that attachment. I am not an experienced user of rules so this may be my ignorance. The SuperUser site would be a better place to ask about such a rule. I will suggest a macro. Start by running the macro manually every hour or once per day or whenever. There are more advanced techniques but let’s get the macro working before we worry about the most convenient way to run it.
First, look at this answer of mine: How to copy Outlook mail message into excel using VBA or Macros
We get a lot of questions along to lines: “I am trying to extract xxxx from emails and copy it to an Excel workbook”. This is accompanied by an image of the email. What the questioners seem unable to understand is that an image of the email tells us nothing about what the email’s body looks like to a VBA macro. Is it text or Html or both? If Html, is the formatting native or CSS? Does it use SPAN or DIV elements with class or id attributes to identify the different sections?
The referenced macro was an attempt to help questioners understand this issue. It creates a new Excel workbook and outputs to it the major properties of every email in Inbox.
There is nothing in your question to suggest you are interested in output to Excel but I think this is a good start for you. It reads down Inbox examining every email. It extracts subject and sender which might be interesting. It lists the type and name of every attachment which you will need. It outputs the text and Html bodies which might be interesting.
Download that macro, change the destination folder as instructed and run the macro. Search the workbook for one of your “log file” emails. Is the text within the Xml file the only indication that it is a log file email? This macro gives the structure you want (it reads down the Inbox) but contains lots of stuff of no interest to you. You can either delete the uninteresting bits from that macro or create a new macro by extracting the interesting bits. Can you do that? If you cannot, you will not be able to cope with the more advanced functionality necessary for a complete solution to your requirement.
I will have to update, the referenced answer. I have recently upgraded to Outlook 2016 and have found an issue. My installation does not use the default Inbox which the macro searches so the macro would create an empty workbook. Outlook 2016 has created a “store” per email address with names of the form: abcdefghi#isp.com. In the folder pane, these are the top names in each hierarchy. Each of these stores contains its own Inbox which is where new emails sent to the relevant address are stored. If your installation is like mine, you will have to replace:
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
by
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").Folders("abcdefghi#isp.com").Folders("Inbox")
Once you have the structure of your macro, the next problem is to identify the emails with an Xml attachment that contains the identifying text. You cannot look at an email’s attachment directly. You have to save them to disc and process them there. With VBA you can open an Xml file as a text file and scan for the identifying text. If I understand correctly, it is Xml files containing the identifying text you require. If so, if an Xml contains the identifying text, it is left on disc otherwise it is deleted. If the Xml file is retained, you need to move the email to another folder so it will not be examined again.
I have: (1) saved attachments to disc, (2) moved emails from one folder to another and (3) processed text files with VBA, although never from Outlook, but never in one macro. I will treat this as a training exercise for myself and develop the code you need to drop into the macro I have told you to develop.
Possible issue 1: How big are these log files? There seem to be a limit of around 15Mb for emails. VBA can easily process files of 15Mb but you do not want to load an entire file of this size into memory if the identifying text is in the first 1,000 bytes.
Possible issue 2: Do the log files have unique names? If they have unique names, they can be saved under those names. If they do not have unique names, unique names will have to be generated for them. A unique name could be as simple as “LFnnnn.Xml” where “nnnn” is one more than the number of the previous log file. Alternatively, it could be as complex as you want.
Update
Rereading your question, I believe if I may have misinterpreted your requirement. I read that you wanted the log file attachments moved to a disc folder. I believe niton read it the same way. I now believe you want the mail item moved to a new Outlook folder and do not specify what is to happen to the log file attachment. I do not think this misinterpretation is important or makes a material difference to the required macro. An email containing a log file has to be moved to a new Outlook because otherwise it would be processed again and again. A log file has to be extracted to a disc folder so that its contents can be checked. My code leaves an Xml file containing the identifying text on disc. One additional statement would delete such an Xml file just as those Xml files that do not contain the identifying text are deleted. I assume the log files have to be extracted sometime. Perhaps you did not appreciate that they would have to be extracted to meet your requirement. I leave you to decide whether or not to add that Kill statement.
I said the default Inbox may not be the Inbox into which these emails are loaded. I have created a little macro that outputs the user name of the store containing the default Inbox which you may find helpful:
Sub DsplUsernameOfDefaultStore()
Dim NS As Outlook.NameSpace
Dim DefaultInboxFldr As MAPIFolder
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
Set DefaultInboxFldr = NS.GetDefaultFolder(olFolderInbox)
Debug.Print DefaultInboxFldr.Parent.Name
End Sub
The following macro does all the heavy lifting for your requirement:
Public Sub SaveInterestingAttachment(ByRef ItemCrnt As MailItem, _
ByVal IdentExtn As String, _
ByVal IdentText As String, _
ByVal DestDiscFldr As String, _
ByRef DestOlkFldr As MAPIFolder)
' * ItemCrnt may contain one or more attachments which have extension
' IdentExtn and which contains text IdentText. If it contains such
' attachment(s) then the macro:
' * saves all such attachments to disc folder DestDiscFldr
' * moves the mail item to output folder DestOlkFldr.
' * Comparisons of IdentExtn and IdentText against file extensions and
' contents are case insensitive because the strings are converted to
' lower case before comparisons.
' * The phrase "saves all such attachments" is perhaps slightly
' misleading. An attachment can only be checked to contain the
' identifying text by saving it to disc, opening it and scanning the
' contents. So all attachments with extension IdentExtn are saved to
' disc and those that do not contain IdentText are deleted.
' Warning: This code assumes DestDiscFldr has a trailing \
' Warning: This code does not test for an existing file with the same name
' Warning: To compile, this macro needs a Reference to "Microsoft Scripting
' RunTime". Click Tools then References. Click box against
' "Microsoft Scripting RunTime" if not already ticked. The Reference
' will be at the top if ticked. Unticked references are in
' alphabetic sequence.
Const ForReading As Long = 1
Const OpenAsAscii As Long = 0
Dim FileContents As String
Dim FileXml As TextStream
Dim Fso As FileSystemObject
Dim InxA As Long
Dim LcExtn As String: LcExtn = LCase(IdentExtn)
Dim LenExtn As Long: LenExtn = Len(IdentExtn)
Dim LcIdText As String: LcIdText = LCase(IdentText)
Dim MoveEmail As Boolean
Dim PathFileName As String
With ItemCrnt
If .Attachments.Count > 0 Then
Set Fso = CreateObject("Scripting.FileSystemObject")
MoveEmail = False
For InxA = 1 To .Attachments.Count
If Right$(LCase(.Attachments(InxA).FileName), 1 + LenExtn) = _
"." & LcExtn Then
' My test files do not have unique names. Adding received time and
' subject was an easy way of making the names unique and demonstrates
' some options.
PathFileName = DestDiscFldr & Format(.ReceivedTime, "yymmddhhmmss") & _
" " & .Subject & " " & _
.Attachments(InxA).FileName
.Attachments(InxA).SaveAsFile PathFileName
Set FileXml = Fso.OpenTextFile(PathFileName, ForReading, OpenAsAscii)
FileContents = FileXml.ReadAll
' If your log files are large snd the identifying text is near
' the beginning, Read(N) would read the first N characters
If InStr(1, LCase(FileContents), LcIdText) <> 0 Then
' Xml file contains identifiying text
' Leave Xml on disc. Move email to save folder
MoveEmail = True
FileXml.Close
Else
' Delete Xml file. Leave email in Inbox unless another attachment
' contained the identifying text
FileXml.Close
Kill PathFileName
End If
Set FileXml = Nothing
End If
Next
If MoveEmail Then
.Move DestOlkFldr
End If
Set Fso = Nothing
End If
End With
End Sub
This macro has five parameters:
A reference to the Mail Item to be tested.
The value of the extension to be tested.
The value of the identifying text.
The value of the disc folder to which attachments are to be saved.
A reference to the Outlook folder to which appropriate Mail Items are to be moved.
I am very confident that eventually this code will have to be called from two different parent macros so making the Mail Item a parameter was necessary. The other parameters could have been hard coded into the macro but making them parameters was no extra effort and parameters are usually easier to explain that values buried in the body of a macro.
You need to work down this macro reading the comments and reviewing the statements. My test data is based on my understanding of your requirement. If I have misunderstood and my test data is faulty, this macro may fail with your data. You will need to carefully check the code and then carefully test it with your data.
I needed a test harness to test this macro since a macro with parameters cannot be called by the user. If you have created a macro to read down the Inbox, it will be very similar to my test harness. My test harness reads down the Inbox and calls SaveInterestingAttachment for each Mail Item.
Even more than SaveInterestingAttachment, this macro must be carefully checked and updated. This macro references folders on my disc and folders within my Outlook installation. These references will have to be updated.
Sub TestSaveInterestingAttachment()
' For every mail item in Inbox, call SaveInterestingAttachment.
Dim DestOlkFldr As MAPIFolder
Dim SrcOlkFldr As MAPIFolder
Dim InxItemCrnt As Long
Dim NS As Outlook.NameSpace
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
' You only need one of the next two Set statements. If your Inbox is not
' Outlook's default then amend the second to reference your default Inbox.
' This is the easiest way to reference the default Inbox.
' However, you must be careful if, like me, you have multiple email addresses
' each with their own Inbox. The default Inbox may not be where you think it is.
Set SrcOlkFldr = NS.GetDefaultFolder(olFolderInbox)
' This references the Inbox in a specific PST or OST file.
' "abcdefghi#MyIsp.com" is the user name that Outlook gave the PST file in
' which it stores emails sent to this account when I created the account. The user
' name is the name Output displays to the user. The file name on disk is different.
Set SrcOlkFldr = NS.Folders("abcdefghi#MyIsp.com").Folders("Inbox")
' I do not know where you want to save processed emails.
' In this description, a "store" is a file on disc in which Outlook stores
' your mail items, calendar items, tasks and so on. When you look at the
' folder pane, names against the left edge are the user names of stores.
' Indented names are folders within a store. The name of the file on disc
' is probably the same as the user name but with an extension of PST or OST.
' The first Set statement below shows how to reference a folder at the same
' level as Inbox in the same store. It does this by using property Parent to
' go up one level and then property Folders to go down one level.
' The second Set statement below shows how to reference a sub-folder of
' Inbox. It does this by using property Folders to go down one level.
' The third Set statement below shows how tp reference a folder "Processed2"
' within folder "Inbox" within store "outlook data file".
' None of these Set statements will meet your requirements. Use these
' examples to build a Set statement suitable for your requirements.
Set DestOlkFldr = SrcOlkFldr.Parent.Folders("!Tony")
Set DestOlkFldr = SrcOlkFldr.Folders("Processed3")
Set DestOlkFldr = NS.Folders("outlook data file").Folders("Inbox").Folders("Processed2")
' This examines the emails in reverse order.
' If I process email number 5 and then move it to another folder,
' the number of all subsequence emails is decreased by 1. If I looked at the
' emails in ascending sequence, email 6 would be ignored because it would have
' been renumbered when I looked for it. By looking at the emails in reverse
' sequence, I ensure email 6 has bee processed before the removal of email 5
' changes its number.
With SrcOlkFldr.Items
For InxItemCrnt = .Count To 1 Step -1
If .Item(InxItemCrnt).Class = olMail Then
' I am only interested in mail items.
' You will need to replace the identying text and the
' destination disc folder
Call SaveInterestingAttachment(.Item(InxItemCrnt), "Xml", _
"identifying text", _
"C:\DataArea\SO\", DestOlkFldr)
End If ' .Class = olMail
Next InxItemCrnt
End With
End Sub
I have attempted a second test harness. I have recently upgraded to Outlook 2016 and this is the first time I have attempted to use events with it. Code which worked perfectly with my previous version no longer works. There are a number of possible reasons for this code not working. Until I have identified the cause, I will give no further information about this second test harness.
Update 2
I have now fixed the problem with my second test harness. A statement that worked with Outlook 2003, which I was still using until a couple of months ago, apparently does not work with Outlook 2016.
You will need a routine based on my first test harness because that routine searches Inbox for log file emails that have already arrived. I also believe it is an easier routine for testing SaveInterestingAttachment until you have updated it to your exact requirements.
The second test harness sits in the background monitoring new emails and processing those containing log files.
I have a home installation and emails register as new when they are downloaded from my ISP’s server to my hard drive. An email can only be downloaded while I have Outlook open. Once I have run test harness 1 to clear my Inbox of previously received log file emails, I can rely on test harness 2 to handle any future log file emails.
If you have an office installation, then your emails may register as new when they reach your organisation’s server. If that is the case, you will always need a routine based on test harness 1 to handle those log file emails that arrive overnight or whenever you do not have Outlook open.
From within Outlook’s Visual Basic Editor, look as the Project Explorer pane. On my installation, the top line is “Project1 (VbaProject.OTM)”. On your installation, the top line might be slightly different.
If there is a “+” to the left of “Project1 (VbaProject.OTM)”, click that “+” to display the items under “Project1 (VbaProject.OTM)”. On my installation these are: “Microsoft Outlook Objects”, “Forms” and “Modules”. You will not have any forms.
If there is a “+” to the left of “Microsoft Outlook Objects”, click that “+” to display the items under “Microsoft Outlook Objects”. The only item displayed will be “ThisOutlookSession”.
Click “ThisOutlookSession” and the code area will become blank. This is a special code area. Previously you will have created modules which are suitable for storing general routines. The code below will only work if it is within “ThisOutlookSession”.
As before, this code will have to be amended to match your Outlook installation and your disc layout. The full code is at the bottom but I introduce it bit by bit to help you understand what it is doing.
My code contains:
Option Explicit
Two variables that can be accessed by either of the subroutines.
Subroutine Application_Startup()
Subroutine InboxItems_ItemAdd(ByVal Item As Object)
You should have Option Explicit at the top of every module. Look it up if you do not know why.
Subroutine Application_Startup() will be executed every time you open Outlook. With this routine in place, you will be warned about “ThisOutlookSession” before Outlook opens. You need to enable macros if Application_Startup() is to be executed.
I suggest you start by copying the following:
Private Sub Application_Startup()
' This event routine is called when Outlook is started
Dim UserName As String
With Session
UserName = .CurrentUser
End With
MsgBox "Welcome " & UserName
End Sub
Having copied this code to "ThisOutlookSession", close Outlook and save your VBA project. Reopen Outlook, enable macros and you will see a message box saying "Welcome Stephanie". This serves no useful purpose but ensures we have the envelope correct before we do anything important.
Copy: Private WithEvents InboxItems As Items. Study the statement starting Set InboxItems = and the comments above it. You will need to construct a version of this statement appropriate for your Inbox. This Set statement makes InBoxItems reference to the Inbox. To confirm, go to the end of the macro where you will find:
Debug.Print InboxItems.Count
If InboxItems.Count > 0 Then
With InboxItems.Item(1)
Debug.Print .ReceivedTime & " " & .Subject & " " & .SenderEmailAddress
End With
End If
These statements output the number of items in the Inbox and details of the first email which is almost certainly the oldest email. Once you have copied these statements, close Outlook, save the VBA project and then open Outlook again. If all is as it should be, the Immediate Window will contain a count and details of an email. If it is not, we need to identify the cause and correct it before continuing.
Copy: Private DestOlkFldr As MAPIFolder. Study the statement starting Set DestOlkFldr = and the comments above it. You will need to construct a version of this statement appropriate for your destination Outlook folder. Again go to the end of the macro where you will find:
Debug.Print DestOlkFldr.Name
Debug.Print DestOlkFldr.Parent.Name
Debug.Print DestOlkFldr.Parent.Parent.Name
On my system these display:
Processed2
Inbox
Outlook Data File
Copy or create as many Debug.Print statements as appropriate for how deeply nested your destination Outlook folder is. Close Outlook, save the VBA project and then open Outlook again. Are the correct names displayed? If so, Sub Application_Startup() is correct. Delete the diagnostic statements which are no longer required.
We are now ready to create Sub InboxItems_ItemAdd(ByVal Item As Object). I would start with:
Private Sub InboxItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is MailItem Then
With Item
Debug.Print "Mail item received at " & .ReceivedTime & " from " & _
.SenderEmailAddress & "(" & .Sender & ")"
End With
End If
End Sub
Close Outlook, save the VBA project, open Outlook again and wait for some emails to arrive. If necessary, send yourself an email. Details of those emails should be in the Immediate Window.
Finally, update and copy this statement:
Call SaveInterestingAttachment(Item, "Xml", _
"identifying text", _
"C:\DataArea\SO\", DestOlkFldr)
Close Outlook, save the VBA project, open Outlook again and wait for some log file emails to arrive. Are they being processed correctly?
Finally, a recap:
Application_Startup() is a reserved name. A subroutine with this name will be executed automatically when Outlook is opened. This is an example of an event routine. Event routines are executed when the appropriate event occurs. I have included the code in Application_Startup()necessary to prepare for the new email arrived event.
InboxItems_ItemAdd(ByVal Item As Object) is the reserved name and mandatory specification for the Add item to InboxItems (that is new email arrived) event routine. InboxItems was the WithEvents variable we declared at the top and initialised with Application_Startup().
If you are not used to thinking about computer events and what you want to happen when they occur, they can be a little tricky to understand although once you do, you will have difficulty remembering what the problem was. I have introduced them in tiny steps. This is how I try out new functionality. If necessary, sleep on it. Trust me, suddenly it will all make sense.
Come back with questions as necessary but the more you can understand on your own, the faster you will develop.
Option Explicit
Private WithEvents InboxItems As Items
Private DestOlkFldr As MAPIFolder
Private Sub Application_Startup()
' This event routine is called when Outlook is started
Dim UserName As String
With Session
' In TestSaveInterestingAttachment() you have a statement like:
' Set SrcOlkFldr = NS.GetDefaultFolder(olFolderInbox)
' or Set SrcOlkFldr = NS.Folders("abcdefghi#Isp.com").Folders("Inbox")
' You need a similar statement here without the "NS" at the beginning
' and with ".Items" at the end. For example:
'Set InboxItems = .GetDefaultFolder(olFolderInbox).Items
Set InboxItems = .Folders("abcdefghi#Isp.com").Folders("Inbox").Items
' In TestSaveInterestingAttachment() you have a statement like:
' Set DestOlkFldr = SrcOlkFldr.Parent.Folders("!Tony")
' or Set DestOlkFldr = SrcOlkFldr.Folders("Processed3")
' or Set DestOlkFldr = NS.Folders("outlook data file").Folders("Inbox").Folders("Processed2")
' There is no equivalent of SrcOlkFldr here so you cannot use the first two formats
' as a basis for the statement here. You must use the third format, without the
' leading NS, at the basis for the statement here. For example:
Set DestOlkFldr = .Folders("outlook data file").Folders("Inbox").Folders("Processed2")
UserName = .CurrentUser
End With
MsgBox "Welcome " & UserName
Debug.Print InboxItems.Count
If InboxItems.Count > 0 Then
With InboxItems.Item(1)
Debug.Print .ReceivedTime & " " & .Subject & " " & .SenderEmailAddress
End With
End If
Debug.Print DestOlkFldr.Name
Debug.Print DestOlkFldr.Parent.Name
Debug.Print DestOlkFldr.Parent.Parent.Name
End Sub
Private Sub InboxItems_ItemAdd(ByVal Item As Object)
' This event routine is called each time an item is added to Inbox because of:
' "Private WithEvents InboxItems As Items" at the top of this ThisOutlookSession
' and
' "Set InboxItems = Session.GetDefaultFolder(olFolderInbox).Items"
' or "Set InboxItems = Session.Folders("abcdefghi#Isp ").Folders("Inbox").Items"
' within "Private Sub Application_Startup()"
If TypeOf Item Is MailItem Then
With Item
Debug.Print "Mail item received at " & .ReceivedTime & " from " & _
.SenderEmailAddress & "(" & .Sender & ")"
End With
' You will need to replace the identying text and the
' destination disc folder
Call SaveInterestingAttachment(Item, "Xml", _
"identifying text", _
"C:\DataArea\SO\", DestOlkFldr)
End If
End Sub
I use Outlook 2007 on Windows 7. I have recently installed iCloud have unfortunately realised that Google Calendar Sync will only sync the default calendar. I was wondering if someone could help me out with a simple VBA macro that would
Empty the default calendar of all appointments
Copy all appointments from the iCloud Calendar to the default calendar
Many thanks!
Health warning
Everything in this answer was discovered by experimentation. I started with VB Help, used F2 to access the object model and experimented until I found what worked. I did buy a highly recommended reference book but it contained nothing important I had not discovered and omitted much that I had discovered.
I suspect that a key feature of the knowledge I have gained is that it is based on many different installations. Some of the problems encountered may have been the result of installation mistakes which would explain why reference book authors did not know of them.
The code below has been tested with Outlook 2003. I have tested similar code with Outlook 2007.
Output selected properties of appointments within default Calendar to Immediate window
You reported that the first version of this routine gave an error: "Runtime error '-2147467259 (80004005)': You must enter a positive duration."
According to the websites I found with Google, error 80004005 means a system file is corrupt.
An appointment has three related items: Start (type Date), End (type Date) and Duration (type Long). I assume either End or Duration is derived at runtime. My guess is that either Duration is negative or End is before Start. I notice in the list of appointments created by this macro on my system that some all day events have property AllDayEvent = False. I seem to recall I once discovered that creating an appointment and later switching AllDayEvent on or off created an inconsistency.
I have added code which attempts to detect this problem but I cannot test it because I have no appointments that give this error on my system. This macro was only intended to get you started with a list of your current appointments so let us not worry to much if you cannot get it working.
Sub ReviewCalendar()
Dim DateTimeEnd As Date
Dim DateTimeStart As Date
Dim Duration As Long
Dim ItemMine As Object
Dim ItemMineClass As Long
Dim FolderTgt As MAPIFolder
Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
' I use this macro to list selected properties from the test calendar.
' Add a quote to the statement above and remove the quote from the next
' statement to do the same.
'Set FolderTgt = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").Folders("Test Folders"). _
Folders("Calendar")
For Each ItemMine In FolderTgt.Items
With ItemMine
' Occasionally I get syncronisation
' errors. This code avoids them.
ItemMineClass = 0
On Error Resume Next
ItemMineClass = .Class
On Error GoTo 0
If ItemMineClass = olAppointment Then
Debug.Print "** Subject: " & .Subject
Debug.Print " Created: " & _
Format(.CreationTime, "d mmm yy hh:mm:ss")
Debug.Print " Updated: " & _
Format(.LastModificationTime, "d mmm yy hh:mm:ss")
Debug.Print " Time: ";
DateTimeStart = .Start
If .AllDayEvent Then
Debug.Print "All day " & Format(.Start, "d mmm yy")
Else
On Error Resume Next
DateTimeEnd = .End
Duration = .Duration
On Error GoTo 0
If Duration <= 0 Then
Debug.Print " ##### Invalid duration #####"
End If
Debug.Print Format(.Start, "h:mm") & " to " & _
Format(.End, "h:mm") & "(" & .Duration & _
" minutes) on " & Format(.Start, "d mmm yy")
End If
' If you remove the quote from the following statement
' it will delete the appointment.
' .Delete ' Delete appointment
End If
End With
Next
End Sub
Preparing to test copying of appointments
I suggest you create a test folder so you can test macros without effecting anything important.
From the Toolbar, select File, New, Outlook Data File, Office Outlook Personal Folders File (.pst).
A window appears listing your existing PST files. On my system these are: archive.pst, Outlook.pst and Test.pst.
At the bottom the default file name is selected. Enter "Test" or other name of your choice.
Another window appears so you can (1) select the name used for the new personal folder in the Outlook Explorer window and (2) select the level of encryption. Enter "Test" or other name of your choice. (Outlook will add " Folders" to your name.) I do not encrypt or password protect message on my system but that is a choice for you.
From the toolbar, select Go, Folder List. The folder list will appear in place of the Output Explorer window.
Right click folder "Calendar" then select New Folder. The New Folder window appears.
Enter the name as "Calendar" and select Test Folders as its location.
Now, when you select Calendar, you will be offered "Calendar in Test Folders" as an additional choice.
Copy appointments from default Calendar to test Calendar
This macro creates a copy in the test Calendar of every appointment in the default Calendar.
Run it once then select Calandar and tick both the default and the test Calendar. The two calendars should be identical.
Warning: If you run the macro again, you will end with two copies of each appointment.
Sub CopyCalendar()
Dim FolderDest As MAPIFolder
Dim ItemCopy As AppointmentItem
Dim ItemMine As Object
Dim ItemMineClass As Long
Dim NameSpaceMine As NameSpace
Dim FolderSrc As MAPIFolder
Set NameSpaceMine = _
CreateObject("Outlook.Application").GetNamespace("MAPI")
With NameSpaceMine
Set FolderSrc = .GetDefaultFolder(olFolderCalendar)
Set FolderDest = .Folders("Test Folders").Folders("Calendar")
End With
Debug.Print FolderSrc.Items.Count
Debug.Print FolderDest.Items.Count
For Each ItemMine In FolderSrc.Items
With ItemMine
' Occasionally I get syncronisation
' errors. This code avoids them.
ItemMineClass = 0
On Error Resume Next
ItemMineClass = .Class
On Error GoTo 0
' I have never found anything but appointments in
' Calendar but test just in case
If ItemMineClass = olAppointment Then
Set ItemCopy = .Copy
ItemCopy.Move FolderDest
End If
End With
Next
End Sub
Next steps
The Set FolderDest statement shows how to select a partcular folder by working down its hierarchy. There are other, more general, techniques but this should be sufficient for your requirements if you can access the iClound Calendar in this way.
Set NameSpaceMine = _
CreateObject("Outlook.Application").GetNamespace("MAPI")
With NameSpaceMine
Set FolderDest = .Folders("Test Folders").Folders("Calendar")
End With
The first macro includes the code to delete every appointment in a calendar and the second copies appointments from one calendar to another.
Combining and adapting this code would give you a one-way synchronisation. That is, it would make Calendar 2 a copy of Calendar 1. Is this adequate? Would overwriting the iCloud Calendar with the default Calendar be adequate? Two-way synchronisation is more complicated. I have experienced several "enterprise" synchronisation routines and none were fool-proof. If you are of the "enterprise means over priced, poor quality sofware" school, you will not be surprised. Otherwise you may agree that two-way synchronisation is difficult or that both statements are true.
The issues are:
Non-identifying properties in either calendar may be changed.
An appointment may be added to or deleted from either calendar.
Identifying properties in either calendar may be changed. Typically subject and or start time are identifying properties but the subject may be changed and the appointment may be moved.
On my system, CreationTime and LastModificationTime are copied unchanged so there are options around using them as identifiers. I have no means of testing the effect on CreationTime and LastModificationTime of a calendar being updated because of meeting request.
I leave you to consider these issues and decide how you wish to take this matter forward.
I am receiving continues emails from customer (different customers) to update their asset details in database.. once process done .. I have to reply (including cc) from their mail telling like "asset details successfully stored in Database" (am using template) using VBA.
Option Explicit
Public Sub ReplyToAll()
Dim oExp As Outlook.Explorer
'for selected mails in outlook
Dim oSM As mailItem
Dim oNM As mailItem
On Error GoTo Err
Set oExp = Outlook.Application.ActiveExplorer
'Check if something is selected
If oExp.Selection.Count > 0 Then
'Get the first item selected
Set oSM = ActiveExplorer.Selection.Item(1)
'Create a Reply template
Set oNM = oSM.ReplyAll
With oNM
'Change the subject
.Subject = "RE: " & oSM.Subject
'Change the body
.Body = .Body & Chr(13) & Chr(13)
'Display the new mail before sending it
.Display
End With
End If
Exit Sub
Err:
MsgBox Err.Description, vbCritical
End Sub
section 3
Sub ReplyAll()
Dim objOutlookObject As mailItem
For Each objOutlookObject In GetCurrentOutlookItems
With objOutlookObject
.ReplyAll.Display
'prob area code does not include the template saved in the location c ..throws some error
.createitemtemplate("c:\car.jtm")
End With
Next
End Sub
Function GetCurrentOutlookItems() As Collection
Dim objApp As Outlook.Application
Dim objItem As Object
Dim colItems As New Collection
Set objApp = CreateObject("Outlook.Application")
On Error Resume Next
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
For Each objItem In objApp.ActiveExplorer.Selection
colItems.Add objItem
Next
Case "Inspector"
colItems.Add objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select
Set objApp = Nothing
Set GetCurrentOutlookItems = colItems
End Function
I am sorry my comment was so curt; 500 characters does not leave much room for a full answer.
Your question is very unclear so it is likely to be closed. Certainly, I do not see how anyone could answer it. That is why it is important that you try to solve your own problem and return as necessary with specific questions.
Below I provide links to recent posts that I believe will help you get started. As I said in my comment, look through recent posts. Use the search facility. There are some very good answers here if you look for them.
The first two posts are tutorials written by me. The early steps are the same but, because the questions were not quite the same, later steps are different. Look at both and pick out the bits relevant to you. The others posts all contain information you may find helpful.
How to import the outlook mail data to excel
update excel sheet based on outlook mail
could anyone guide me in creating an outlook macro that does the following
send an email from excel 2007 vba using an outlook template set variables
using visual basic to access subfolder in inbox
vba outlook event moving email
New section in response to new information from questioner
Except for minor modifications, the code in your question was taken from the Microsoft Help file for NewMailEx Event. This code will only work if you have the correct type of installation and if you place it in the correct place:
"The NewMailEx event will only fire for mailboxes in Microsoft Outlook that provide notification for received message such as Microsoft Exchange Server. Also, the event will fire only if Outlook is running. In other words, it will not fire for the new items that are received in the Inbox when Outlook was not open. Developers who want to access these items for customers running Outlook on an Exchange server e-mail account need to implement their code on the server. However, the NewMailEx event will fire against Cached Exchange Mode in all settings: Download Full Items, Download Headers, and Download Headers and then Full Items."
Do you have the correct type of installation? Can you place your code on the server? Even if this is the correct approach for the final version of your macro, I do not believe it is the correct approach while you are learning VBA and Outlook.
You need two things:
a detailed specification of the macro you wish to write and
more understanding of VBA and Outlook.
I doubt you can create the detailed specification yet because you do not know enough about VBA and Outlook. But we can list things you will need to know:
How do you write to your database from Outlook?
How do you identify the mail items you wish to record? In your example, you are checking for a subject of "Hello" and replying "Hi". This is fine for a first experiment but you need to identify the real method. Is it a new sender? Is there specific information in the body of the message? Does a human have to identify such mail items?
In your example, you have a folder "Personal" under "Inbox". Many people seem to have this type of folder structure and Microsoft examples tend to use folders like this. I do not. I have a folder called "!Home". Under this I have folders for "Insurance", "Shopping", "Money". Under these I have folders for my different suppliers. Once I have dealt with a message, I move it to appropriate folder. Replies go to the same folder. This is my system and it works for me. What is your system going to be? Will, for example, there be a single folder for all customers or one per customer?
The above is a starter list of questions for your specification but it is also a starter list of things you need to know.
Perhaps you have a boss who wants you to stop wasting time and start writing the macro but you do not know enough yet to plan the final macro.
Start with my tutorials. The first three steps are about the folder structure. These steps are essential if you have the kind of complex folder structures I have. Next I go through a folder displaying selected information from each mail item. I have steps in which I write message bodies to disc. I suggest you go through both tutorials and try my code. Not all of it will be immediately useful but it is all good background information.
What is your database? Is it Access or Excel? There is some help in my tutorials and in the other links above with writing to Excel which you could adapt for Access.
I think the above is enough for now. Take it slowly and it will start to make sense. I still remember the first time I tried to write an Outlook macro so I understand your confusion. I promise that it will become clear. Best of luck.
New section in response to the following comment:
"hello i have tried ..Got what i want....Removed my previous code..and tried replaced the new code .. Now little help needed from you ....is there any way to use same format like when we click the replyall button in outlook .. my code working fine ..prob is format of the mail is differ .."
Problem 1
.Body = .Body & Chr(13) & Chr(13)
You are using the text body. I think you want the HTML body. Try:
.HTMLBody = .HTMLBody & Chr(13) & Chr(13)
Problem 2
You cannot add to the HTML body in this way. The HTML body will be:
<!doctype ...><html><head> ... </head><body> ... </body></html>
You must add your text to the beginning of the body; that is, just after <body>. If you just add your text, you will be accepting whatever style, margins and colours the sender has used. The following code adds some text that looks the same in every email I have tried it with. My text is within a table with a single cell. The table covers the full width of the page. The text is blue on a white background.
Dim InsertStg As String
Dim Inx As Long
Dim Pos As Long
'Change the body step 1: Create the string to be inserted
InsertStg = "<table border=0 width=""100%"" style=""Color: #0000FF""" & _
" bgColor=#FFFFFF><tr><td><p>"
For Inx = 1 To 10
InsertStg = InsertStg & "Sentence " & Inx & " of first paragraph. "
Next
InsertStg = InsertStg & "</p><p>"
For Inx = 1 To 10
InsertStg = InsertStg & "Sentence " & Inx & " of second paragraph. "
Next
' The following adds a signature at the bottom of the message.
' "font-family" gives a list of fonts to be tried. If these are
' missing from your computer, use the names of fonts you do have.
' "serif" means that if none of the fonts exist any serif font
' that exists is to be used.
InsertStg = InsertStg & "</p><p style = ""font-family: Mistral, " & _
"Vivaldi, serif; font-size: 14px; color: " & _
"rgb(127,0,127)"">John Smith<br>5 Acacia Avenue<br>"
InsertStg = InsertStg & "</p></td></tr></table>"
'Change the body step 2: Find insertion position just after <Body> element
Pos = InStr(1, LCase(.HTMLBody), "<body")
If Pos = 0 Then
Call MsgBox("<Body> element not found in HTML body", vbCritical)
Exit Sub
End If
Pos = InStr(Pos, .HTMLBody, ">")
If Pos = 0 Then
Call MsgBox("Terminating > for <Body> element not found in HTML body", vbCritical)
Exit Sub
End If
'Change the body step 3: Insert my text into body
.HTMLBody = Mid(.HTMLBody, 1, Pos) & InsertStg & Mid(.HTMLBody, Pos + 1)
I get thousands of Nagios alerts in my inbox daily, but many of them are actually trivial (even though Nagios reports them as critical). I want to check whether the text of these alerts contains numbers above a certain threshold; if the numbers are lower than that threshold, move the message to a junk folder. I should really work with my sysadmin to decrease the number of useless alerts Nagios sends in the first place, but humor me in my attempt at a creative workaround.
I'm using Outlook 2007 and have found several tutorials on writing Outlook macros in VB, including this one about programmatically creating a rule to move messages to different folders. That example uses a TextRuleCondition to check whether the subject contains any of the keywords in an array.
But I don't want to check for keywords, I want to check if a number in the message text is greater or less than a threshold value. For example, if the text of a message contains the following, it could be moved to a junk folder:
Nagios bad condition: foo = 3
But if a message contained this, I would want to keep it:
Nagios bad condition: foo = 157
This example seems a little more like what I want in terms of searching the content of the message for arbitrary text. But it requires the message to be open, so I'm not quite sure how to translate it into a rule. Any help would be appreciated.
The second example you link to will put you on the right track to write code that discriminates between good and junk e-mails.
Then you will want to put that code in the _ItemAdd event for the Inbox items, such that it runs every time something new pops up in your Inbox. Here's an example of what should go in your Outlook VBA module:
Public WithEvents myOlItems As Outlook.Items
Public Sub Application_Startup()
' Upon starting Outlook, set reference to the items in the Inbox.
Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
' Because myOlItems is declared "WithEvents",
' the ItemAdd event will fire anytime something new pops up in the Inbox.
If TypeName(Item) = "MailItem" Then
' It's an e-mail.
' Here goes the code to test whether it should go to the junk folder.
Else
' It's something else than an e-mail.
' Do nothing.
End If
End Sub
JFC has already given you one way. Here is another using RULES to check messages as they arrive. Do this.
Open VBA Editor and paste this code in ThisOutlookSession
UNTESTED
Option Explicit
Sub Sample(MyMail As MailItem)
Dim strID As String, olNS As Outlook.NameSpace
Dim objInboxFolder As Outlook.MAPIFolder
Dim objDestinationFolder As Outlook.MAPIFolder
Dim olMail As Outlook.MailItem
Dim strFileName As String, strSubj As String
Dim Myarray() As String
Dim ThrsdVal As Long
strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)
'~~> Email Subject
strSubj = olMail.Subject
'~~> Threshold value
ThrsdVal = 100
'Nagios bad condition: foo = 3
Myarray = Split(strSubj, "=")
Set objInboxFolder = olNS.GetDefaultFolder(olFolderInbox)
'~~> Destination folder
Set objDestinationFolder = objInboxFolder.Folders("Temp")
'~~> Check if less than threshold value
If Val(Trim(Myarray(1))) < ThrsdVal Then
olMail.Move objDestinationFolder
End If
Set olMail = Nothing
Set olNS = Nothing
End Sub
Now
1) Create a new Rule (Select "Check Messages When they Arrive")
2) In (Condition) select "From people or Distribution List"
3) Select the relevant email address from which you are getting the emails
4) In Actions, select "run a script" and then choose the above script.
5) Finally click on Finish and you are done :)
The best part about this is that you can run this rule for existing emails in your inbox folder as well :)
NOTE: Like I mentioned above, I have not tested the code so do let me know if you get any errors and I will rectify it. Also I am assuming that the message will have a subject with the format as "Nagios bad condition: foo = X". I have not included any error handling. I am sure you can take care of that :)
HTH
Sid