I am trying to run outlook VBA to find and replace text from original email to new email to bunch of stakeholders.
Finding difficulty to run the script.
Scenario, I get an email which has Company Name list. So whenever I am running this script it should replace with company name listed on the original email.
Below is my script.
Sub Test()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Dim oRespond As Outlook.MailItem
Dim strcompany As String
Dim strHTML As String
Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("C:\Users\test-.oft")
strcompany = InputBox("Issue : ", "Replace %company%")
strHTML = Replace(replyEmail.HTMLBody, "Company:", strissue)
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.Reply.HTMLBody
replyEmail.Subject = replyEmail.Subject & origEmail.Reply.Subject
replyEmail.Display
End Sub
Use Explorer.SelectionChange (use Application.ActiveExplorer) to track the selection change
Set up event handlers on the selected emails.
When MailItem.Reply event fires, you can read properties from the original message and populate the properties on the new message passed as the parameter to the event handler.
You can do the same for the messages replied to from the open inspectors (use Inspectors.NewInspector event to track the message opened in inspectors).
Related
I have programmed a macro that should extract the content of received mails into an Excel sheet if the mail subject contains a specific word.
All in all its working, but the macro executes as soon as I receive a mail. That leads to a pop-up window in Outlook every time I receive a mail, but I only want it to pop up if I receive a mail with the specific subject.
I have to find another solution for the line:
If TypeName(item) = "MailItem" Then Set olMail = item
The entire code:
Private Sub olItems_ItemAdd(ByVal item As Object)
'Variablen dimensionieren
Dim olMail As Outlook.MailItem
Dim oxLApp As Object, oxLwb As Object, oxLws As Object
Set oxLApp = GetObject(, "Excel.Application")
Set oxLwb = oxLApp.Workbooks.Open _
("C:\Users\A2000\Desktop\Makros_NewScoping")
Set oxLws = oxLwb.Sheets("Slide 3")
'Prüfen ob Item eine Mail ist
If TypeName(item) = "MailItem" Then
Set olMail = item
If InStr(olMail.Subject, "APPROVAL REQUIRED") And _
olMail.SenderName = "Test, Name" Then
With oxLws
.Range("Q24") = olMail.VotingResponse
.Range("E41") = olMail.Body
End With
End If
There is no need to run any extra code if the mail arrived doesn't correspond to your conditions:
Private Sub olItems_ItemAdd(ByVal item As Object)
'Variablen dimensionieren
Dim olMail As Outlook.MailItem
Dim oxLApp As Object, oxLwb As Object, oxLws As Object
'Prüfen ob Item eine Mail ist
If TypeName(item) = "MailItem" Then
Set olMail = item
If InStr(olMail.Subject, "APPROVAL REQUIRED") And _
olMail.SenderName = "Test, Name" Then
Set oxLApp = GetObject(, "Excel.Application")
Set oxLwb = oxLApp.Workbooks.Open _
("C:\Users\A2000\Desktop\Makros_NewScoping")
Set oxLws = oxLwb.Sheets("Slide 3")
With oxLws
.Range("Q24") = olMail.VotingResponse
.Range("E41") = olMail.Body
End With
End If
Note, creating a new Excel instance each time a new item is added to the folder is not really a good idea. Moreover, the ItemAdd event is fired not only for incoming emails, but also for every email moved to the folder. So, when an item is moved to the folder you will get the code triggered.
That is why I'd suggest handling the NewMailEx event of the Application class. This event fires once for every received item that is processed by Microsoft Outlook. The item can be one of several different item types, for example, MailItem, MeetingItem, or SharingItem. The EntryIDsCollection string contains the Entry ID that corresponds to that item. Use the Entry ID represented by the EntryIDCollection string to call the NameSpace.GetItemFromID method and process the item.
You need to move the code that opens Excel to below the If statement where you check the server and the subject.
I am trying to change incoming emails subject line to only the last 11 characters of the subject line. When I use Item.Subject = Right(Item.Subject,11) it does not work.
Can someone assist?
Full code.
Sub ChangeSubjectForward(Item As Outlook.MailItem)
Item.Subject = Right(Item.Subject, 11)
Item.Save
End Sub
You could create a macro rule then run the below code:
Sub save_to_dir_test1(mymail As MailItem)
Dim strID As String
Dim objMail As Outlook.MailItem
strID = mymail.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
objMail.Subject = Right(m.Subject, 11)
objMail.Save
Set objMail = Nothing
End Sub
For more information, please refer to this link:
Run a Script Rule: Change Subject then Forward Message
Getting the incoming email in outlook via VBA
I found another SO thread that says you can't modify the subject of a message without opening it first. We can use ActiveInspector to get a handle on the Item after we display it. Then we can change it, save it, and close it. I added a check to see if the subject is actually longer than 11 characters before we attempt to truncate it.
Try this:
Public Sub ChangeSubjectForward(ByRef Item As Outlook.MailItem)
Debug.Print Now ' This shows you when the code runs
If Len(Item.Subject) > 11 Then
Debug.Print "Subject is too long. Trimming..." ' This shows that we tried to truncate.
Item.Display 'Force the pop-up
Dim thisInspector As Inspector
Set thisInspector = Application.ActiveInspector
Set Item = thisInspector.CurrentItem ' Get the handle from the Inspector
Item.Subject = Right$(Item.Subject, 11)
Item.Save
Item.Close
End If
End Sub
I would like to reply to a message inline with a outlook template using a macro.
I am currently using the below code to perform the reply with a template but this opens a pop out reply window.
Sub Reply_Scripting()
Dim origEmail As MailItem
Dim replyEmail As MailItem
Set origEmail = Application.ActiveWindow.Selection.Item(1)
Set replyEmail = Application.CreateItemFromTemplate("C:\Test.oft")
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.reply.HTMLBody
replyEmail.Display
End Sub
I have searched and found there has been similar question answered here. However, I was not able to modify the code to make it work successfully in my case.
Thanks.
I have noticed the following line of code:
replyEmail.HTMLBody = replyEmail.HTMLBody & origEmail.reply.HTMLBody
Note, you need to get a well formed HTML markup and assign it to the HTMLBody property. But it looks like you try to merge two HTML pages into a single one by adding one to another.
Instead, you need to paste the body content of the template you are loading in the code at the beginning of the body section of the existing item. I.e. right after the <body> tag.
This is what I have for an "auto reply". This DOES NOT allow editing before sending, but easily modified to do so. See comments in code.
Sub ReplyMSG()
Dim olItem As Outlook.MailItem
Dim olReply As MailItem ' Reply
For Each olItem In Application.ActiveExplorer.Selection
olItem.UnRead = False '<<----This marks the email as Read
Set olReply = olItem.ReplyAll '<<----This replies to all recipients
olReply.HTMLBody = "Insert a message or template here" & olReply.HTMLBody
olReply.Display '<<-----Use this to display the email before sending
olReply.Send '<<-----Comment this out if you want to edit before sending
Next olItem
End Sub
I want to export the contents of any email that is received to a text file automatically. If there is text already in that text file, then the new text should overwrite it.
A rule can be made to run this script when an email is received.
For example:
I receive an email that says "Happy Birthday".
The text "Happy Birthday" should be saved to "incomingEmail.txt"
Sub extractDataAsString(item As Outlook.MailItem)
Dim olItem As Outlook.MailItem
Dim sText As String
Set olItem = ActiveExplorer.Selection.item(1)
sText = olItem.Body
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim Fileout As Object
Set Fileout = fso.CreateTextFile("K:\Project\Python\incomingEmail.txt", True, True)
Fileout.Write sText
Fileout.Close
End Sub
The code above exports the currently selected e-mail's body to the text file. I want to export the body of the new e-mail to the text file.
I think this is because of the line:
Set olItem = ActiveExplorer.Selection.item(1)
However, I can't find how to select the latest e-mail.
The item that triggers run a script code is passed to the code. There is no need to find it again.
Sub RunAScript_code(item As Outlook.MailItem)
MsgBox "The item that triggered this code is: " & item.subject
End Sub
how do I move the files once its been send out successfully to c:\complete
Can I limit the attachments to 10 attachments per email.
each file size is like 300kb
Option Explicit
Sub SendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim objOutlookFile As String
'// Attachment Path
AttachmentPath = "C:\Reports\"
'// Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
'// Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
'// Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("omar")
Set objOutlookRecip = .Recipients.Add("omar")
objOutlookRecip.Type = olTo
'// Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add("omar")
objOutlookRecip.Type = olCC
'// Set the Subject, Body, and Importance of the message.
.Subject = "Reports"
.Body = "the Attached reports are complete !" & vbCrLf & vbCrLf
.Importance = olImportanceHigh '//High importance
'// Add attachments to the message.
objOutlookFile = Dir(AttachmentPath & "*.*")
Do While Len(objOutlookFile) > 0
.Attachments.Add AttachmentPath & objOutlookFile
objOutlookFile = Dir
Loop
'// Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
'//.DeleteAfterSubmit = True
'//.Send
.Display
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
It is not clear where you run the VBA macro code (Outlook, Word, Excel and etc.).
Anyway, there is no need to create a new Outlook Application instance in the Outlook VBA macro:
'// Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
Instead, you can use the Application property, for example:
'// Create the message.
Set objOutlookMsg = Application.CreateItem(olMailItem)
You can use the FileSystemObject for managing files on the disk. See Accessing Files with FileSystemObject for more information.
Also the Outlook object model provides the BeforeAttachmentAdd event for Outlook items which is fired before an attachment is added to an instance of the parent object. It provides an instance of the Attachment class to be added and the Cancel parameter which can be used to cancel the action. Just set to true to cancel the operation; otherwise, set to false to allow the Attachment to be added.
sorry one more question, can I stop outgoing email if there is no files in c:\reports\
The best way is to check the folder before runnig the VBA macro. You can use the FileSystemObject to get the job done.
The Application class from the Outlook object model provides the ItemSend event which is fired whenever 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. It provides the item reference being sent and the Cancel parameter. If the event procedure sets the Cancel argument to true, the send action is not completed and the inspector is left open.
You can use both these events to check out whatever you need.
Finally, you may find the Getting Started with VBA in Outlook 2010 article in MSDN helpful.