I want to make a script rule which sends to a sub folder, marks as certain category and saves attachment (90% of time PDF) in certain g:drive folder with a file naming convention.
Sub folders:
Direct
PO
Confirmation
Delivery Notes
Invoices
Statements
Categories:
PO
Confirmation
Delivery Note
Invoice
Statement
;don't require a "Direct Category"
I'm able to use normal Outlook rules for move to folder and assign category. There are about 30 individual rules based on supplier name. etc.
Had a look at some VBA scripts. Would I need 30 different scripts to tag onto my 30 current move to folder/assign category scripts to assign the separate file name pathways?
Or can I adapt a script that knows if a email hits "Invoice" it saves to G:\My Drive\Outlook attachments\Invoices
Email hits Delivery Notes it saves toG:\My Drive\Outlook attachments\Delivery Notes
File naming Convention; not thought too much into yet.
Date & Time received email and who supplier is. Joe Bloggs Ltd 17.09.21 11.34am
Also a way of marking if any duplicate files Joe Bloggs Ltd 17.09.21 11.34am (2)
You can create a VBA macro where you could subscribe to the ItemAdd event of each folder and depending on the target folder you may run a different code. The ItemAdd event is fired when one or more items are added to the specified collection. For example:
Public WithEvents myOlItems As Outlook.Items
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
Dim myOlMItem As Outlook.MailItem
Dim myOlAtts As Outlook.Attachments
Set myOlMItem = myOlApp.CreateItem(olMailItem)
myOlMItem.Save
Set myOlAtts = myOlMItem.Attachments
' Add new contact to attachments in mail message
myOlAtts.Add Item, olByValue
myOlMItem.To = "Sales Team"
myOlMItem.Subject = "New contact"
myOlMItem.Send
End Sub
Note, an instance of the item that was added is passed as a parameter to the event handler, so you can extract the required information or attachments.
Related
I created a rule to move a daily email to a specific folder and run a VBA script to save the table from this email's body.
When the email is received, VBA starts running and grabbing previous email with the same subject and only after does the new email appear in my target folder.
I tried sleep.
Is there any way to first move new email to a target folder then run a script?
Sub ExportOutlookTableToExcel()`
Dim oLookInspector As Inspector
Dim oLookMailitem As MailItem
Dim oLookWordDoc As Word.Document
Dim oLookWordTbl As Word.Table
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWrkSheet As Excel.Worksheet
'Grab Email Item
Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
Set oLookInspector = oLookMailitem.GetInspector
Set oLookWordDoc = oLookInspector.WordEditor
Re: I created a rule to move this email to a specific folder and run a VBA script
You are not the first to fall into this trap. Put the move as the last action in the code.
Consider not using "run a script" code in rules. There is ItemAdd for any folder or NewMailEx for the Inbox.
Re: Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
The most recent mail with subject "Apples Sales" can be found like this:
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Sub mostRecentlyReceivedMail_Subject_DemoOnly()
Dim oLookFolder As Folder
Dim oLookFolderItems As Items
Dim srchSubject As String
Dim i As Long
Dim oLookMailitem As MailItem
Set oLookFolder = ActiveExplorer.CurrentFolder
Set oLookFolderItems = oLookFolder.Items
' sort the collection not the folder
oLookFolderItems.Sort "[ReceivedTime]", True
srchSubject = "Apples Sales"
' This is demonstration code only.
' Without introducing methods to reduce the number of items to look through
' it shows the use of an index rather than subject.
' In this case the required item is supposed to be first in the collection.
For i = 1 To oLookFolderItems.Count
' first verify object in folder is a mailitem
If oLookFolderItems(i).Class = olMail Then
' Index not subject
Set oLookMailitem = oLookFolderItems(i)
If oLookMailitem.subject = srchSubject Then
Debug.Print oLookMailitem.ReceivedTime
oLookMailitem.Display
Exit For
End If
End If
Next
End Sub
Although subject is valid in
Set oLookMailitem =Application.ActiveExplorer.CurrentFolder.Items("Apples Sales")
it probably has little to no practical use.
I creted a rule to move this email to a specific folder and run a vba script to save the table from this new emails body.
There is no need to create a rule and run a VBA script. Instead, to handle incoming emails immediately you need to handle the NewMailEx event which is fired when a new message arrives in the Inbox and before client rule processing occurs. You can use the Entry ID returned in the EntryIDCollection array to call the NameSpace.GetItemFromID method and process the item. Use this method with caution to minimize the impact on Outlook performance. However, depending on the setup on the client computer, after a new message arrives in the Inbox, processes like spam filtering and client rules that move the new message from the Inbox to another folder can occur asynchronously. You should not assume that after these events fire, you will always get a one-item increase in the number of items in the Inbox. Also you may consider handling the ItemAdd event on the folder where your items are moved. But it has a known disadvantage - the event is not fired if more than sixteen items are moved at the same time. This is a known issue when dealing with OOM.
In the NewMailEx event handler you may get an instance of the incoming email and move it to the required folder programmatically where you could run any other actions.
We send emails from a shared outlook address
And now I want to find out how many emails I answer everyday because my boss wants to give me more work but I want to get an idea of how I actually compared to my colleagues before I agree on taking more work
Wondering if it's possible to count how many sent emails we send everyday and then filter that based on our signatures
Thank you
The best and the most easiest way is to handle the ItemSend event which is fired when an Microsoft Outlook item is sent, either by the user through an Inspector (before the inspector is closed, but after the user clicks the Send button) or when the Send method for an Outlook item, such as MailItem, is used in a program.
Public WithEvents myOlApp As Outlook.Application
Public Sub Initialize_handler()
Set myOlApp = Outlook.Application
End Sub
Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
So, each time the ItemSend event is fired we can increase the counter.
Another possible solution is to use the Find/FindNext or Restrict methods for getting the number of items that contain specific keywords in the message body. Read more about them in the following articles:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
How To: Get unread Outlook e-mail items from the Inbox folder
If the signature includes something unique to the user, just search the Sent Items folder for a match in the Body property using Items.Find/FindNext or Items.Restrict.
I want to look for specific items inside specific subfolders in Outlook (macro VBA) that can be in first or second level subfolder, however I cannot make it to work. I have found other questions that loop through all the items in all folders, but not that go through all items in specific subfolders.
fldrname = "Clearing"
Set objNS = GetNamespace("MAPI")
Set ClearingFolders = Outlook.Folders("Clearing", objNS.Folders)
For Each ClearingFolders In objParentFolderCollection
For Each folder In ClearingFolders
If InStr(1, fldrname, folder.Name, vbTextCompare) > 0 Then
{findEmail}
End If
Next folder`
Thanks for your help!
The code below demonstrates how to access every mail item within every folder, and sub-folder to any depth, within a parent folder. It does this by outputting an indented list of items and sub-folders to the Immediate Window. The format of the output is:
ParentFolderName
Date Subject (of mail item within ParentFolder
Date Subject (of mail item within ParentFolder
Date Subject (of mail item within ParentFolder
ChildFolder1Name
Date Subject (of mail item within ChildFolder1Name
Date Subject (of mail item within ChildFolder1Name
GrandchildFolder1Name
Date Subject (of mail item within GrandchildFolder1Name
Date Subject (of mail item within GrandchildFolder1Name
ChildFolder2Name
Date Subject (of mail item within ChildFolder2Name
Date Subject (of mail item within ChildFolder2Name
GrandchildFolder2Name
Date Subject (of mail item within GrandchildFolder2Name
Date Subject (of mail item within GrandchildFolder2Name
GreatgrandchildFolder1Name
Date Subject (of mail item within GreatgrandchildFolder1Name
Date Subject (of mail item within GreatgrandchildFolder1Name
ChildFolder3Name
: : : : :
There are statements within your code I do not understand so I have ignored your code and created my own.
Consider first:
Set Fldr = Session.Folders("StoreName").Folders("TopLevelFolderName")
Your equivalent of this statement is:
Set objNS = GetNamespace("MAPI")
Set Fldr = objNS.Folders("StoreName").Folders("TopLevelFolderName")
With VBA there is often more than one way of achieving the same effect. I prefer Session to objNS. My code so my favourites. Change to your favourite if you wish.
A store is a file on disc that Outlook uses to hold mail items, tasks, appointment items and so on. I assume “Clearing” is the name of a folder and not the name of a store. Your folder pane will look something like this:
StoreName1
Clearing1
Deleted Items
Inbox
Sent Items
StoreName2
Inbox
Clearing2
Sent
Trash
You can have as many stores as you wish. There will be one per email address and perhaps one for archives. When I change computers, I add my old stores to my new Outlook installation, so I have access to all my old emails.
It seems there is always an “Inbox”. Other standard folders change their names from version to version so you might have “Deleted Items” or “Trash” or something else. You can add your own folders wherever you like.
If your “Clearing” is a store, you will need:
Set Fldr = Session.Folders("Clearing")
If your “Clearing” is at the same level as “Inbox” like my “Clearing1”, you will need:
Set Fldr = Session.Folders("StoreName1").Folders("Clearing1")
If your “Clearing” is under “Inbox” like my “Clearing2”, you will need:
Set Fldr = Session.Folders("StoreName2").Folders("Inbox").Folders("Clearing2")
Change my statement to match your system.
Notice that I write:
Dim Fldr As Outlook.Folder
but
Dim ItemCrnt As MailItem
This code runs under Outlook so I do not need to specific Outlook. I could have written Outlook.MailItem but it would not add value because VBA only has one data type named MailItem. However, Outlook as two data types Folder; one for disc folders and one for Outlook folders. Outlook VBA will assume you mean Outlook.Folder when you write Folder but I once got myself into a muddle when I did not specify which Folder I meant. Now, I am always careful to write Outlook.Folder or Scripting.Folder so I will not forget when it is important.
The sub ProcessChild is recursive. There are excellent explanations of recursion on the web so I will not attempt my own explanation now. However, if you are confused, I will add an explanation of my routine.
Now consider:
For InxI = 1 To FldrPrnt.Items.Count
: : :
For InxF = 1 To FldrPrnt.Folders.Count
You have used For Each. I sometimes use For Each but I find For Index more convenient most of the time.
FldrPrnt is the folder whose mail items and sub-folders I wish to access. FldrPrnt.Items gives me access to the items and FldrPrnt.Folders gives me access to the sub-folders.
When I write For InxI = 1 To FldrPrnt.Items.Count, I access the items oldest first. If I had written For InxI = FldrPrnt.Items.Count to 1 Step -1, I would have accessed the items newest first. “Oldest” and “Newest” here does not refer to the date of the item. It refers to the order in which items were added to FldrPrnt.Items. Normally mail items are added in date order so these two orders are the same. However, if you accidentally delete an old mail item then move it back from folder “Deleted Items”, it will become the newest item in the folder.
Often you can write either For InxI = 1 To FldrPrnt.Items.Count or For InxI = FldrPrnt.Items.Count to 1 Step -1. However, if your processing involves moving items to another folder, you must use FldrPrnt.Items.Count to 1 Step -1. With For Index, you are identifying items by their position within FldrPrnt.Items. If you move item 20 to another folder, item 21 becomes item 20, item 22 becomes item 21 and so on. For the next repeat of the loop, you will check the new item 21 not the old item 21. We sometimes get questions where someone is only checking half their items. This is the reason.
Notice If TypeName(FldrPrnt.Items(InxI)) = "MailItem" Then. Not every item is a MailItem. It is essential to check an item’s type before processing it since different items have different properties.
I hope the above, is enough for you to understand my code but ask question is necessary. All my code does is display the received time and subject of each mail item. You will have to replace my Debug.Print statement with whatever code you need to achieve your objectives.
Option Explicit
Sub Main()
Dim Fldr As Outlook.Folder
Set Fldr = Session.Folders("StoreName").Folders("TopLevelFolderName")
Call ProcessChild(Fldr, 0)
End Sub
Sub ProcessChild(ByRef FldrPrnt As Outlook.Folder, ByVal Indent As Long)
Dim InxF As Long
Dim InxI As Long
Dim ItemCrnt As MailItem
Debug.Print Space(Indent * 2) & FldrPrnt.Name
For InxI = 1 To FldrPrnt.Items.Count
If TypeName(FldrPrnt.Items(InxI)) = "MailItem" Then
Set ItemCrnt = FldrPrnt.Items(InxI)
With ItemCrnt
Debug.Print Space(Indent * 2 + 2) & .ReceivedTime & " " & .Subject
End With
End If
Next
For InxF = 1 To FldrPrnt.Folders.Count
If FldrPrnt.Folders(InxF).DefaultItemType = olMailItem Then
Call ProcessChild(FldrPrnt.Folders(InxF), Indent + 1)
End If
Next
End Sub
You need to iterate over all folders recursively:
Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder)
Dim oFolder As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem
For Each oMail In oParent.Items
'Get your data here ...
Next
If (oParent.Folders.Count > 0) Then
For Each oFolder In oParent.Folders
processFolder oFolder
Next
End If
End Sub
Also, you may consider using the AdvancedSearch method of the Application class which performs a search based on a specified DAV Searching and Locating (DASL) search string. The key benefits of using the AdvancedSearch method in Outlook are:
The search is performed in another thread. You don’t need to run another thread manually since the AdvancedSearch method runs it automatically in the background.
Possibility to search for any item types: mail, appointment, calendar, notes etc. in any location, i.e. beyond the scope of a certain folder. The Restrict and Find/FindNext methods can be applied to a particular Items collection (see the Items property of the Folder class in Outlook).
Full support for DASL queries (custom properties can be used for searching too). You can read more about this in the Filtering article in MSDN. To improve the search performance, Instant Search keywords can be used if Instant Search is enabled for the store (see the IsInstantSearchEnabled property of the Store class).
You can stop the search process at any moment using the Stop method of the Search class.
Read more about the AdvancedSearch method in the Advanced search in Outlook programmatically: C#, VB.NET article.
So, maybe you don't need to iterate over all folders and search for specific items there any longer?
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 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.