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 have a folder full of emails that are a custom message class (iXOS-Archive, related to OpenText Enterprise Archive). Each email has a custom metadata property, visible within Outlook, called "Document Identifier". I'm trying to extract this from the emails using a VBA script. I found a script that extracts common metadata (To, From, Subject etc.) from the emails and writes it to Excel. This works well.
http://spreadsheetpage.com/index.php/tip/getting_a_list_of_file_names_using_vba/
I've tried debugging the script and looking within the email properties, but I cannot find any collection that contains custom metadata.
Does anyone know how I can access the custom metadata through the VBA script?
You will probably not be able to do this using a FileSystemObject or DIR function (as given in the code you linked to, above).
I am unable to test without a suitable example, but this might work:
Bind Outlook to Excel
Open the MSG file in Outlook
Use the Outlook object model to review the MSG file's .ItemProperties
Practically speaking you will set this up in a loop, similar to your example code, but for the sake of testing, try it out on a single file and see if this will help you.
'Requires reference to Outlook object model
Sub foo()
Dim olApp As Outlook.Application
Dim msg As Outlook.MailItem
Dim properties As Outlook.ItemProperties
Dim p As Long
Set olApp = GetObject(, "Outlook.Application")
Set msg = olApp.CreateItemFromTemplate("C:\your filename.msg")
Set properties = msg.ItemProperties
For p = 0 To properties.Count - 1
Debug.Print properties(p).Name
Next
Set msg = Nothing
Set olApp = Nothing
End Sub
This should print the list of ItemProperties in the Immediate window, scroll through that list and check to see if the one you're looking for -- "Document Identifier" -- is included. If so, then this should work and you can modify as needed to do whatever it is you want to do with that information.
I cannot be of further assistance unless you can provide a test/sample version of this email format.
Cheers.
I'm trying to copy a MailItem inside a mailbox into another folder of a different mailbox with vbscript. Here's my Code
'Example \\Mailbox1\folder\mail item to \\Mailbox2\Folder\mail item
For Each item in objFolder.Items
Dim objCopiedItem : Set objCopiedItem = item.Copy
Call objCopiedItem.Move(objPSTFolder.FolderPath)
Next
Obviously, it does not work. The destination folder is inside another mailbox, and the path looks valid when I debug. What's wrong with that?
MailItem.Move() takes MAPIFolder object as an argument, not a string.
Don't you get an error when you run that script? Do you have "on error resume next" in your code?
I hope it's okay to ask this kind of question. Attempting to write the code myself is completely beyond me at the moment.
I need a macro for Outlook 2007 that will permanently delete all content of the Sent Items folder whenever anything arrives in it. Is it possible? How do I set everything up so that the user doesn't ever have to click anything to run it?
I know I'm asking for a fish, and I'm embarrassed, but I really need the thing...
edit:
I've pasted this into the VBA editor, into a new module:
Public Sub EmptySentEmailFolder()
Dim outApp As Outlook.Application
Dim sentFolder As Outlook.MAPIFolder
Dim item As Object
Dim entryID As String
Set outApp = CreateObject("outlook.application")
Set sentFolder = outApp.GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For i = sentFolder.Items.Count To 1 Step -1
sentFolder.Items(i).Delete '' Delete from mail folder
Next
Set item = Nothing
Set sentFolder = Nothing
Set outApp = Nothing
End Sub
It's just a slightly modified version of a piece of code I found somewhere on this site deleting Deleted Items. It does delete the Sent Items folder when I run it. Could you please help me modify it in such a way that it deletes Sent Items whenever anything appears in the folder, and in such a way that the user doesn't have to click anything to run it? I need it to be a completely automated process.
edit 2: Please if you think there's a better tool to achieve this than VBA, don't hesitate to edit the tags and comment.
edit 3: I did something that works sometimes, but sometimes it doesn't. And it's ridiculously complicated. I set a rule that ccs every sent email with an attachment to me. Another rule runs the following code, when an email from me arrives.
Sub Del(item As Outlook.MailItem)
Call EmptySentEmailFolder
End Sub
The thing has three behaviors, and I haven't been able to determine what triggers which behavior. Sometimes the thing does purge the Sent Items folder. Sometimes it does nothing. Sometimes the second rule gives the "operation failed" error message.
The idea of acting whenever something comes from my address is non-optimal for reasons that I'll omit for the sake of brevity. I tried to replace it with reports. I made a rule that sends a delivery report whenever I send an email. Then another rule runs the code upon receipt of the report. However, this has just one behavior: it never does anything.
Both ideas are so complicated that anything could go wrong really, and I'm having trouble debugging them. Both are non-optimal solutions too.
Would this be an acceptable solution? Sorry its late but my copy of Outlook was broken.
When you enter the Outlook VB Editor, the Project Explorer will be on the left. Click Ctrl+R if it isn't. It will look something like this:
+ Project1 (VbaProject.OTM)
or
- Project1 (VbaProject.OTM)
+ Microsoft Office Outlook Objects
+ Forms
+ Modules
"Forms" will be missing if you do not have any user forms. It is possible "Modules" is expanded. Click +s as necessary to get "Microsoft Office Outlook Objects" expanded:
- Project1 (VbaProject.OTM)
- Microsoft Office Outlook Objects
ThisOutlookSession
+ Forms
+ Modules
Click ThisOutlookSession. The module area will turn white unless you have already used this code area. This area is like a module but have additional privileges. Copy this code to that area:
Private Sub Application_MAPILogonComplete()
' This event routine is called automatically when a user has completed log in.
Dim sentFolder As Outlook.MAPIFolder
Dim entryID As String
Dim i As Long
Set sentFolder = CreateObject("Outlook.Application"). _
GetNamespace("MAPI").GetDefaultFolder(olFolderSentMail)
For i = sentFolder.Items.Count To 1 Step -1
sentFolder.Items(i).Delete ' Move to Deleted Items
Next
Set sentFolder = Nothing
End Sub
I have taken your code, tidied it up a little and placed it within an event routine. An event routine is automatically called when the appropriate event occurs. This routine is called when the user has completed their log in. This is not what you requested but it might be an acceptable compromise.
Suggestion 2
I have not tried an ItemAdd event routine on the Sent Items folder before although I have used it with the Inbox. According to my limited testing, deleting the sent item does not interfere with the sending.
This code belongs in "ThisOutlookSession".
Option Explicit
Public WithEvents MyNewItems As Outlook.Items
Private Sub Application_MAPILogonComplete()
Dim NS As NameSpace
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
With NS
Set MyNewItems = NS.GetDefaultFolder(olFolderSentMail).Items
End With
End Sub
Private Sub myNewItems_ItemAdd(ByVal Item As Object)
Debug.Print "--------------------"
Debug.Print "Item added to Sent folder"
Debug.Print "Subject: " & Item.Subject
Item.Delete ' Move to Deleted Items
Debug.Print "Moved to Deleted Items"
End Sub
The Debug.Print statements show you have limited access to the sent item. If you try to access more sensitive properties, you will trigger a warning to the user that a macro is assessing emails.
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