I have macro to forward an email with the original attachment to everyone which is involved in the original email chain.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim forwardMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set forwardMail = mail.Forward
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With forwardMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To & mail.replyall.CC
.Display
End With
End If
Next
End Sub
Is it possible to mark this email has "replied" instead of "forwarded" email?
yes you need only to change Set forwardMail = mail.Forward to Set forwardMail = mail.Reply
You should also change name of variable forwardMail to replyMail and change all variables in code. full code below.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim replyMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set replyMail = mail.Reply
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With replyMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To & mail.replyall.CC
.Display
End With
End If
Next
End Sub
If you mean you want to change the icon to the one that represents "replied", you can change it in the following way...
' Set property PR_ICON_INDEX to 261
objItem.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x10800003", 261
objItem.Save
Related
I have this code to a vba outlook macro to reply all.
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim replyall As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set replyall = mail.replyall
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With replyall
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.Display
End With
End If
Next
End Sub
I am trying to add a functionality so that when the original email brings an attachment (docx, pdf), when I reply all using this macro it will also use the original attachment and place it as an attachment in the reply all email.
How can I achieve this?
Forward then populate the .To with what would appear in a ReplyAll.
Option Explicit
Sub my_test()
Dim objItem As Object
Dim mail As MailItem
Dim forwardMail As MailItem
Dim templateItem As MailItem
For Each objItem In ActiveExplorer.Selection
If objItem.Class = olMail Then
Set mail = objItem
Set forwardMail = mail.Forward
Set templateItem = CreateItemFromTemplate("C:\template.oft")
With forwardMail
.HTMLBody = templateItem.HTMLBody & .HTMLBody
.To = mail.replyall.To
.Display
End With
End If
Next
End Sub
Below is my macro to send an email but it does not open a new email .
This macro is in the outlook rules.
Have you any ideas?
Sub sendemail()
Dim ns As NameSpace
'Dim newMail As Outlook.MailItem
Set ns = GetNamespace("MAPI")
Dim newMail As MailItem
Set newMail = Application.CreateItem()
With newMail
.To = "aaa#bbb" <--adress to whitch I want to send an email
.Subject = "test"
.Display
End With
Set newMail = Nothing
End Sub
first you need to add up the outlook reference:
There you go:
then:
Sub sendemail()
Dim outlook As New outlook.Application
Dim newMail As outlook.MailItem
Set newMail = outlook.CreateItem(olMailItem)
With newMail
.To = "email#address.com" ' <--adress to whitch I want to send an email
.Subject = "test from Steph"
.Display
.Send
End With
Set newMail = Nothing
outlook.Quit
Set outlook = Nothing
End Sub
Argument must be type MailItem or MeetingItem for the subroutine to be available in Outlook Rules Wizard.
Try this.
Option Explicit
Sub SendEmail(NewMail As Outlook.MailItem)
Set NewMail = Application.CreateItem(olMailItem)
With NewMail
.To = "aaa#bbb" '<--adress to whitch I want to send an email
.Subject = "test"
.Display
End With
Set NewMail = Nothing
End Sub
Youre not specifying the item to create. See here:
Private Sub SendEmail(ByVal workcenter As Integer, ByVal time As Date)
Dim objApp As Object
Dim objEmail As Object
Set objApp = CreateObject("Outlook.Application")
Set objEmail = CreateObject("Outlook.MailItem")
With objEmail
.To = "emailexampe#website.com"
.Subject = "Multiple Shop Orders run for line " & workcenter & " at " & time
.body = "TEST"
.display
End With
Set objEmail = Nothing
Set objApp = Nothing
End Sub
Source: http://www.vbforums.com/showthread.php?536558-RESOLVED-Outlook-late-binding
this version also uses late binding, so you dont need any additional references.
I am trying to achieve:
the email was sent to Outlook "Sent Items" folder therefore email is
not in the "Outbox" folder.
email did not return due to delivery failure (email will be in the
"Inbox" folder deliver by postmaster#mail.hotmail.com)
The following code is used to send an email from an Access form via Outlook:
Private Sub cmdEmail1_Click()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strBody As String
Dim strPDF As String
Dim strFolder As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strBody = Me.txtSubject
strPDF = Me.txtFile
On Error Resume Next
With OutMail
.To = Me.txtemail
.CC = ""
.BCC = Me.txtBBCemail
.Subject = Me.txtSubject
.Body = Me.txtMessage
.Recipients.ResolveAll
' .SendUsingAccount = OutApp.Session.Accounts.Item(2) '2nd email
.SentOnBehalfOfName = Me.txtFromEmail
.Attachments.Add strPDF 'attachments
.Send
End With
Me.txtSent = "email was sent to Outlook "
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Thanks a lot
Norbert
Both of these will be asynchronous and you will be able to process the notification at a later point, seconds or even minutes later.
I don't think #1 will help you much - it only tells you that the network was not disconnected. Why does it matter? Even if it is down, Outlook will send the message later.
For #2, it all depends on who sent the NDR. If it is Exchange, you will be able to figure out the bad recipient address. Otherwise you might just get a message with no good way to figure out what the problematic recipient was.
EDIT. For Items.ItemAdd, see the following (off the top of my head):
Dim OutApp As Outlook.Application
Dim WithEvents SentItems As Outlook.Items
sub SentItems_ItemAdd(Item As Object)
MsgBox Item.Subject
end sub
Private Sub cmdEmail1_Click()
Dim OutMail As Outlook.MailItem
Dim strBody As String
Dim strPDF As String
Dim strFolder As String
Dim ns As Outlook.Namespacee
if (OutApp Is Nothing) Then
Set OutApp = CreateObject("Outlook.Application")
set ns = OutApp.GetNamespace("MAPI")
ns.Logon
set SentItems = ns.GetDefaultFolder(olFolderSentMail).Items
End If
Set OutMail = OutApp.CreateItem(olMailItem)
strBody = Me.txtSubject
strPDF = Me.txtFile
On Error Resume Next
With OutMail
.To = Me.txtemail
.CC = ""
.BCC = Me.txtBBCemail
.Subject = Me.txtSubject
.Body = Me.txtMessage
.Recipients.ResolveAll
' .SendUsingAccount = OutApp.Session.Accounts.Item(2) '2nd email
.SentOnBehalfOfName = Me.txtFromEmail
.Attachments.Add strPDF 'attachments
.Send
End With
Me.txtSent = "email was sent to Outlook "
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I'm looking to use the get function in vba in order to activate a specific email in Outlook and then copy the body into a new email and send. I can use the getlast function to get the latest email in the inbox, however I would like to refine the code some more by selecting the latest email from a specific email address.
Also, I'd love how to know how to delete the signature from the text pasted into the new email.
Sub Negotiations()
Dim objMsg As Outlook.MailItem
Dim objItem As Outlook.MailItem
Dim BodyText As Object
Dim myinspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim NewMail As MailItem, oInspector As Inspector
Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
myItem.Display
'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
' Create the message.
Set objMsg = Application.CreateItem(olMailItem)
'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste
'set up and send notification email
With objMsg
.To = "#gmail.com"
.Subject = "Negotiations"
.HTMLBody = activeMailMessage.HTMLBody
.Display
End With
End Sub
any help would be appreciated, thank you guys!
Open the Inbox folder using Namespace.GetDefaultFolder(olFolderInbox), retrieve the Items collection from MAPIFolder.Items. Sort the items (Items.Sort) on the ReceivedTime property, retrieve the latest email using Items.Find on the SenderEmailAddress property.
Dependant on what your property of .SenderEmailAddress returns, you can adapt what the while statement evaluates for. This should work for you, by first looking at the last e-mail, and then checking each previous e-mail for the correct sender address.
Sub display_mail()
Dim outApp As Object, objOutlook As Object, objFolder As Object
Dim myItems As Object, myItem As Object
Dim strSenderName As String
Set outApp = CreateObject("Outlook.Application")
Set objOutlook = outApp.GetNamespace("MAPI")
Set objFolder = objOutlook.GetDefaultFolder(olFolderInbox)
Set myItems = objFolder.Items
strSenderName = UCase(InputBox("Enter the e-mail Alias."))
Set myItem = myItems.GetLast
While Right(myItem.SenderEmailAddress, Len(strSenderName)) <> strSenderName
Set myItem = myItems.GetPrevious
Wend
myItem.Display
End Sub
Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
First of all, I'd recommend breaking the chain of calls. Declare each property or method call on a separate line of code, so you will be able to debug the code at any time and see what happens under the hood.
The GetLast method returns the last object in the collectio. But it doesn't mean that the item is recieved last. You need to sort the collection using the Sort method as Dmitry suggested passing the ReceivedTime property as a parameter to sort on. Only in that case you will get the last recieved item from the collection.
The Outlook object model doesn't provide any special method or property for identifying signatures. You need to parse the message body and find it programmatically.
Sub Nego()
Dim objMsg As Outlook.MailItem
Dim myItem As Outlook.MailItem
Dim BodyText As Object
Dim Inspector As Outlook.MailItem
Dim olNameSpace As Outlook.NameSpace
Dim olfolder As Outlook.MAPIFolder
Dim msgStr As String
Dim endStr As String
Dim endStrStart As Long
Dim endStrLen As Long
Dim myItems As Outlook.Items
'Access folder Nego
Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Set objFolder = objMailbox.Folders("Nego")
'Mark as read
For Each objMessage In objFolder.Items
objMessage.UnRead = False
Next
'Sort
Set myItems = objFolder.Items
For Each myItem In myItems
myItems.Sort "Received", False
Next myItem
myItems.GetLast.Display
'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
' Create the message.
Set objMsg = Application.CreateItem(olMailItem)
'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste
'Search Body
Set activeMailMessage = ActiveInspector.CurrentItem
endStr = "first line of signature"
endStrLen = Len(endStr)
msgStr = activeMailMessage.HTMLBody
endStrStart = InStr(msgStr, endStr)
activeMailMessage.HTMLBody = Left(msgStr, endStrStart + endStrLen)
'set up and send email
With objMsg
.To = "#email"
.Subject = "Nego"
.HTMLBody = activeMailMessage.HTMLBody
.HTMLBody = Replace(.HTMLBody, "First line of signature", " ")
.Send
End With
End Sub
I have a user who wants to redirect any email to other people in their department so that when that person replies to the email it will go back to the person who originally sent it.
I am trying to make VBA code to forward all emails in a specified folder and change the reply to address so that they don't have to manually put it in every time.
Sub SendFolder()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Dim MyFolder As Outlook.MAPIFolder
Dim ObjMail As Outlook.MailItem
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set MyFolder = Application.Session.Folders("me#us.com").Folders("test")
For i = MyFolder.Items.Count To 0 Step -1
Set ObjMail.Subject = MyFolder.Itmes(i).Subject
Set ObjMail.ReplyRecipients = MyFolder.Itmes(i).ReplyRecipients
Set ObjMail.Body = MyFolder.Itmes(i).Body
Set ObjMail.Attachments = MyFolder.Itmes(i).Attachments
Set ObjMail.BodyFormat = MyFolder.Itmes(i).BodyFormat
Set ObjMail.To = "test#us.com"
ObjMail.Send
Next
End Sub
You are missing
Set ObjMail = Application.CreateItem(olMailItem)
Then your code would become
With ObjMail
.Subject = MyFolder.Itmes(i).Subject
.ReplyRecipients = MyFolder.Items(i).ReplyRecipients
.Body = MyFolder.Items(i).Body
.Attachments = MyFolder.Items(i).Attachments
.BodyFormat = MyFolder.Items(i).BodyFormat
.To = "test#us.com"
.Send
End with
It it runs now, the ReplyTo does not change.
You will want to set the ObjMail's ReplyRecipients property
Something like .ReplyRecipients.Add MyFolder.Items(i).SenderEmailAddress
To simplify the issue, .Forward the mail as is, and set only the ReplyRecipients property.
Check out this alternative. The mail is sent as an attachment. The receiver automatically replies to the original sender.
Untested
Sub SendFolderItemsAsAttachments()
' Run this VBA code while in Outlook
Dim MyFolder As MAPIFolder
Dim notMyItems as Items
Dim notReplyingToMe as mailitem
Dim i as long
Set MyFolder = Application.Session.Folders("me#us.com").Folders("test")
Set notMyItems = MyFolder.Items
For i = notMyItems.Count To 1 Step -1
If TypeOf notMyItems(i) Is MailItem Then
Set notReplyingToMe = Application.CreateItem(olMailItem)
With notReplyingToMe
.Subject = notMyItems(i).Subject & " - " & _
notMyItems(i).SenderName
.HTMLBody = "Redirecting for your action."
.Attachments.Add notMyItems(i), olEmbeddeditem
.To = "test#us.com"
.Send
End With
notMyItems(i).Delete
End If
Next
Set MyFolder = = Nothing
Set notMyItems = Nothing
Set notReplyingToMe = Nothing
End Sub