I am working on a vba macro to extract the text contained in an email that is sent to me every day at a specified email address
I want to generate a vba macro that triggers when this arrives.
The text needs to be saved to a text file "c:\temp\email.txt"
I have collated various bits of code, but nothing really works.
Can anyone advise a simple vba method to do this?
You may find my answer to How to copy Outlook mail message into excel using VBA or Macros gives you a start.
That answer shows how to run down the Inbox extracting selected information from every email including sender, subject and text body. With this as a start you could write a macro that searches the Inbox for the email of interest and exports it to a text file.
What you really want is an event routine that is triggered when an item is added to the Inbox but that is more advanced so get a macro that searches Inbox working first.
Outlook has a robust security system so you will find when you run the search macro that you have to give it permission to access your emails. You can self-certify your own macros but I have never managed the final step of suppressing the "A macro is accessing your emails" message. If you run the macro once a day, giving permission is not a problem but if you want to have an event routine you will have to confirm the permission every 10 minutes.
Visit the following sites for information or seek help elsewhere:
Signing your own macros with SelfCert.exe: http://www.howto-outlook.com/howto/selfcert.htm
Manage Trusted Root Certificates: http://technet.microsoft.com/en-us/library/cc754841.aspx
I can get the instructions in the first to work but not those in the second.
If you can crack the Manage Trusted Root Certificates problem, adding an event routine is not difficult. Within Outlook's Visual Basic Editor, The project explorer will look something like this:
- Project1(VbaProject.OTM)
+ Microsoft Office Outlook Objects
+ Forms
+ Modules
Click the pluses as necessary to get:
- Project1(VbaProject.OTM)
- Microsoft Office Outlook Objects
* ThisOutlookSession
+ Forms
+ Modules
Select ThisOutlookSession. This is like a module but has extra privileges. Copy the code below to ThisOutlookSession and you have the start of the event routine you seek.
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(olFolderInbox).Items
End With
End Sub
Private Sub myNewItems_ItemAdd(ByVal Item As Object)
Dim text As String
Debug.Print "--------------------"
Debug.Print "Item added to Inbox"
With Item
Debug.Print "Subject: " & .Subject
Debug.Print "Sender name: " & .SenderName
Debug.Print "Sender address: " & .SenderEmailAddress
text = Mid(.Body, 1, 100)
text = Replace(text, vbLf, "{lf}")
text = Replace(text, vbCr, "{cr}")
text = Replace(text, vbTab, "{tb}")
text = Replace(text, Chr$(160), "{nbsp}")
Debug.Print "Start of body: " & text
End With
Related
I want to automate these actions, on an open message (either received or sent):
save all the attachments in a folder through a popup letting the user to select the destination folder
This command already exist inside the Action > Other Actions submenu, but the problem is that no trace remains visible in the message about the former presence of attachments, so - as in Lotus Notes - I would like to:
edit the message to introduce some text at the beginning, something such a message like "Attachment removed on " and, even better, the path where the attachments have been saved.
I tried to start understanding Outlook VBA but I feel rather uncomfortable with it.
You have asked far too much in one question to hope for a complete answer. This site is for programmers to help one another develop. Your question should include some faulty code so a more experienced programmer can explain where you have gone wrong.
I understand you feeling uncomfortable with Outlook VBA. When I started, I bought a highly recommended book and found it very unhelpful. I learnt through experimentation. I still experiment when I want to understand something new. I also read through the Outlook questions and answers here. There are some extraordinarily knowledgeable people answering questions. I find that continually adding to my understanding of what can be achieved with Outlook helpful even if I do not expect to ever use some of the more exotic functionality.
You need to break your complete task into small sub-tasks. If your sub-task is small enough you can probably find something relevant if you search. My breakdown of your task is:
Allow user to identify Outlook folder from which attachments are to be saved.
Allow user to identify disc folder to which attachments are to be saved.
Read down Outlook folder looking for emails with user attachments.
For each email with user attachments:
4(a) save attachments to disc folder,
4(b) delete attachments from email
4(c) edit email body with details of deleted attachments.
I will provide some code to get you started with sub-tasks 1 and 3. You should be able to find help on sub-task 2 without too much difficulty. I will include some guidance on sub-tasks 4(a), 4(b) and 4(c).
I would have thought the easiest way for the user to identify the Outlook folder would be for the user to open that folder and then start the macro. That is the approach I have taken. Please copy this code to a module, open an appropriate Outlook folder and run the macro. I believe I have included enough comments to explain what the macro is doing but ask questions if necessary:
Option Explicit
Sub DemoSelectFolderFromEmail()
Dim Exp As Explorer
' VBA has two types of Folder: Outlook folders and disc folders.
' Since you will need access to disc folders, it is important to be clear
' which type you mean.
Dim FldrSrc As Outlook.Folder
Dim InxA As Long
Dim InxF As Long
Dim ItemCrnt As MailItem
' Get collection of emails selected by user.
Set Exp = Outlook.Application.ActiveExplorer
' Check that an email has been selected.
If Exp.Selection.Count = 0 Then
Call MsgBox("Please select an email then try again", vbOKOnly)
Exit Sub
ElseIf Exp.Selection.Item(1).Class <> olMail Then
Call MsgBox("Please select an email then try again", vbOKOnly)
Exit Sub
End If
' The parent of a selected email is the Outlook folder that contains it.
' In my view, this is the easiest way for the user to identify the source
' folder.
Set FldrSrc = Exp.Selection.Item(1).Parent
Debug.Print FldrSrc.Name
' FldrSrc.Items is a collection of the items in FldrSrc.
' Probably every itemn is a MailItem but I check to be sure.
' ReceivedTime and Subject are just two of the properties that you can access.
' If there are any attachments, I display their names.
' Note that for VBA, signatures and images count as attachments. You will need
' to add code to idetify these attachments if you do not want to save them.
For InxF = FldrSrc.Items.Count To 1 Step -1
With FldrSrc.Items(InxF)
If .Class = olMail Then
Debug.Print .ReceivedTime & " " & .Subject
If .Attachments.Count > 0 Then
For InxA = 1 To .Attachments.Count
With .Attachments(InxA)
Debug.Print " " & InxA & " " & .DisplayName
End With
Next
End If
End If
End With
Next
End Sub
SaveAsFile is the method that writes an attachment to a disc folder. Note that SaveAsFile will overwrite any existing file with the same name. If the same DisplayName is used for different attachments, you will need to have some system of making names unique.
You will need to edit the emails to delete the attachments and then save the edited emails.
An email can have a text body and or an Html body and or a RTF body. I have never seen a RTF body so you can probably ignore them. If an email has both a text and an Html body, the user sees the Html body. It is rare these days for an email not to have an Html body. You can probably get away with just adding a string at the start of the Html body but you will need to experiment to ensure the appearance is satisfactory. I would probably prefer to insert, at the beginning of the body section, a complete Html string controlling background colour, font colour, font size and font name so that I the appearance of the insert text was always the same.
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'm attempting to generate an email from MS Access when a particular procedure is run and certain conditions are met, the email will include a hyperlink. I've found the sendobject macro command does not allow for hyperlink, only static text. It seems that the solution is to code the portion of the entire process that generates and sends the email in VBA and call on that code in the appropriate segment of my if function within my macro.
I can't figure out the appropriate code to generate and send and email with a hyperlink to an individual however. It will be very simple, single recepient, unchanging title, and the body will read 'New providers require designation, please access the provider designation dashboard for provider designation' ideally the provider designation dashboard would be the hyperlink and point to a shared network space.
What commands do I need to accomplish this, I'm inexperienced in VBA and this is eating up a fair amount of time I don't have.
Thank you
There are some different approaches for sending e-mail with code. The code bellow uses an Outlook Application COM object to generate the message with a hyperlink - thus, it will only work if MS Outlook is installed in the user's machine.
Sub NewEmail(ByVal mylink As String, ByVal therecipient As String)
Dim Outlook As Object, Email As Object
Set Outlook = CreateObject("Outlook.Application")
Set Email = Outlook.CreateItem(0) 'olMailItem = 0
With Email
.Subject = "My Subject" 'message subject
.HTMLBody = "Greetings, please check this link: <a href='" & mylink & "'>Click me</a>." 'message body, in html. concatenate multiple strings if you need to
.To = therecipient 'recipient
'use this if you want to generate the message and show it to the user
.Display
'use this instead if you want the mail to be sent directly
'.Send
End With
Set Email = Nothing
Set Outlook = Nothing
End Sub
Put the code in a module. Then anywhere in your code you may call the procedure with something like:
NewEmail "www.mysite.com/targetpage.html", "persontomail#domain.com"
Notice that the routine above uses late binding. To use early binding (and get intellisese, but with some drawbacks), you would have to add a reference to Microsoft Outlook XX.X Object Library and dim the "Outlook" and "Email" objects as Outlook.Application and Outlook.MailItem, respectively.
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)