I am try to CC second person but I am getting Error run-time 13 Type mismatch.
Option Explicit
'// Auto Replay with notes and email body- run Action Script
Public Sub ReplywithNote(Item As Outlook.MailItem)
Dim olInspector As Outlook.Inspector
Dim olDocument As Word.Document
Dim olSelection As Word.Selection
Dim olReply As MailItem
Dim olRecipient As Outlook.Recipient
Set olReply = Item.ReplyAll
olReply.Display
Set olRecipient = myItem.Recipient.Add("omar")
olRecipient.Type = olCC
Set olInspector = Application.ActiveInspector()
Set olDocument = olInspector.WordEditor
Set olSelection = olDocument.Application.Selection
olSelection.InsertBefore "Received, Thank you."
'// Uncomment to send
olReply.Send
End Sub
Thanks.
Try Recipient not Recipients
Dim olRecipient As Outlook.Recipient
The Add method of the Recipients class creates a new recipient in the Recipients collection. The parameter is the name of the recipient; it can be a string representing the display name, the alias, or the full SMTP e-mail address of the recipient.
If you run the following sample code in Outlook there is no need to create a new Application instance, use the Application property available in VBA out of the box.
Set myOlApp = CreateObject("Outlook.Application") // Application
Set myItem = myOlApp.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add ("Jon Grande")
myRecipient.Type = olCC
Don't forget to call the Resolve method of the Recipient class after adding a new one. Or just the ResolveAll method of the Recipients class to resolve recipients against the address book.
See How to: Specify Different Recipient Types for a Mail Item for more information.
Related
I have been able to create an automated email reply as I wanted. However, I wanted to add text in the body of the email and cc to add email address. How should I add it?
Sub FwdSelToAddr()
Dim objOL As Outlook.Application
Dim objItem As Object
Dim objFwd As Outlook.MailItem
Dim strAddr As String
Dim objRecip As Outlook.Recipient
Dim objReply As MailItem
On Error Resume Next
Set objOL = Application
Set objItem = objOL.ActiveExplorer.Selection(1)
If Not objItem Is Nothing Then
strAddr = ParseTextLinePair(objItem.Body, "Email:")
If strAddr <> "" Then
Set objFwd = objItem.Forward
objFwd.To = strAddr
objFwd.Display
Else
MsgBox "Could not extract address from message."
End If
End If
Set objOL = Nothing
Set objItem = Nothing
Set objFwd = Nothing
End Sub
This is what I have done so far. I just want to be able to add CC email address and text in the body in the automated reply.
You need to modify the code a bit by setting the Cc property and the HTMLBody one if you need to modify or update the message body:
If strAddr <> "" Then
Set objFwd = objItem.Forward
objFwd.To = strAddr
objFwd.Cc = "email#address.com"
objFwd.HTMLBody = "<b>Hello world</b>"
objFwd.Display
Else
Be aware, to preserve the message body from the original email you need to insert your content between the opening <body> and closing </body> tags. If you need to add in the beginning of the message paste your additional text right after the opening tag, if you intend to paste it in the end of message - paste right before the closing tag.
Also you may find the Recipients property of the MailItem class helpful. It allows a more convenient way for setting up recipients for the Outlook items. You can read more about that property in the article that I wrote for the technical blog - How To: Fill TO,CC and BCC fields in Outlook programmatically.
How could I get, with VBA Excel, the Outlook properties of a single contact for whom I have the User Principal Name?
I am interested in the tab labelled "E-mail Addresses".
I managed to get the PrimarySMTP property, but I would like to get the list of all addresses listed there. The 'alias' property gives me one entry, while there are several others.
This is what I did to get the distribution list memberships:
Dim objExchUsr As ExchangeUser
Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim MyAddrList As AddressList
Dim myRecipient As Outlook.Recipient
Dim oDistListEntries As Outlook.AddressEntries
Dim oAE As Outlook.AddressEntry
Set myolApp = CreateObject("Outlook.Application")
Set myNameSpace = myolApp.GetNamespace("MAPI")
Set MyAddrList = myNameSpace.addressLists("Global Address List")
Set myRecipient = myNameSpace.CreateRecipient(strDisplayname)
myRecipient.Resolve
If myRecipient.Resolved Then
Set objExchUsr = myRecipient.AddressEntry.GetExchangeUser
Set oDistListEntries = objExchUsr.GetMemberOfList
For Each oAE In oDistListEntries
If oAE.AddressEntryUserType = olExchangeDistributionListAddressEntry Then
<Do something with the distribution lists: not relevant to this problem>
End If
Next
End If
With this code I get the information shown in the tab 'Member Of' of the Outlook Properties.
How do I get the information that is shown in the tab 'E-mail Addresses'?
Here is the code you could use:
Const PR_EMS_AB_PROXY_ADDRESSES As String = _
"http://schemas.microsoft.com/mapi/proptag/0x800F101F"
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
addresses = _
NS.CurrentUser.AddressEntry.PropertyAccessor.GetProperty(PR_EMS_AB_PROXY_ADDRESSES)
You need to read the PR_EMS_AB_PROXY_ADDRESSES MAPI property (DASL name "http://schemas.microsoft.com/mapi/proptag/0x800F101F") using AddressEntry.PropertyAccessor.GetProperty. You will get back an array of proxy addresses prefixed with the address type (e.g. "EX:" or "SMTP:")
My task is to send an email containing a report and send another email containing another report to the same email thread by way of replying/forwarding to the sent email (excluding some recipients).
Option Explicit
Sub TestReply()
Dim objApp As Application
Dim objNewMail As Outlook.MailItem
Dim objReply As Outlook.MailItem
Set objApp = Outlook.Application
Set objNewMail = objApp.CreateItem(0)
' Outgoing email
With objNewMail
.Subject = "Test sending email"
.To = "abc#abc.com"
.HTMLBody = "This is the outgoing email."
.Send
End With
' Reply email
Set objReply = objNewMail.ReplyAll
With objReply
.HTMLBody = "This is the reply emal."
.Display
End With
Set objApp = Nothing
Set objNewMail = Nothing
Set objReply = Nothing
End Sub
I can't find a way to send the follow up email (either by reply or forward).
When I try the above code, it says error the item is moved/deleted. I guess it is becaused when the email is sent, the objNewMail odject is also terminated.
I tried adding RE: or FW: to the subject of the original email but then the two emails will not be in the same thread but independent emails.
An additional problem is that I have two email accounts in Outlook: my own email and team email and the reports are to be sent from the team email.
You can determine if an item added to the sent folder matches objNewMail.
In ThisOutlookSession
Option Explicit
Private WithEvents sentFolderItems As Items
Private Sub Application_Startup()
'Set sentFolderItems = Session.GetDefaultFolder(olFolderSentMail).Items
' Reference any folder by walking the folder tree
' assuming the team folder is in the navigation pane
Set sentFolderItems = Session.folders("team mailbox name").folders("Sent").Items
End Sub
Private Sub sentFolderItems_ItemAdd(ByVal Item As Object)
Dim myReplyAll As MailItem
If Item.Class = olMail Then
'do not use InStr unless you change some part of words in original subject
' or another reply will be generated
If Item.Subject = "Test sending email" Then
Set myReplyAll = Item.ReplyAll
With myReplyAll
.HTMLBody = "This is the reply email."
.Display
End With
End If
End If
End Sub
Sub TestReply()
Dim objNewMail As MailItem
'Set objNewMail = CreateItem(olMailItem)
' Add, not create, in non-default folder
Set objNewMail = Session.folders("team mailbox name").folders("Inbox").Items.Add
' Outgoing email
With objNewMail
.Subject = "Test sending email"
.To = "abc#abc.com"
.HTMLBody = "This is the outgoing email."
.Send
End With
End Sub
Note: Application. and Outlook. are not needed when code is in Outlook.
Call Send on the original email (objNewMail) only after you construct the reply.
Right so currently your code is doing this:
Creating a mail, sending it.
Trying to reply to the mailitem object which is already sent.
What you need is an event Hook to catch the mail when it's received by yourself. (assuming this is how you're reply all and removing some recipients for report 2)
Here is how you accomplish this:
First Create a WithEvents as Items call AllMyItems, then a hook in the AllMyItems_ItemAdd, then initialize the event when Outlook Starts using Application_Startup (a built in event)
Be very careful to identify criteria for forwarding / actioning the incoming mail item, since this event code will scan every mail sent to your main inbox and evaluate it. IF you want to further reduce the risk of forwarding a mail item to the wrong person, consider using an outlook rule to sort it into a custom folder, and then setting that folder's location as the Set AllMyItems = line instead of default folder
Option Explicit
'for the Default DL inbox
Private WithEvents AllMyItems As Items
Private Sub Application_Startup()
Dim olapp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olapp = Outlook.Application
Set objNS = olapp.GetNamespace("MAPI")
'Set myolitems = objNS.GetDefaultFolder(olFolderInbox).Items
'all my items in the main box
Set AllMyItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set olapp = Nothing
Set objNS = Nothing
End Sub
Private Sub AllMyItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) <> "Mailitem" Then
If TypeName(Item) = "ReportItem" Then GoTo 0 'undeliverables shows as a report item
If TypeName(Item) = "MeetingItem" Then GoTo 0
Dim oItem As MailItem
Dim myForward As MailItem
Set oItem = Item
'use the next line to check for a property of the incoming mail, that distinguishes it from other mail, since this event will run on every mail item
If InStr(1, oItem.Subject, "Your public folder is almost full", vbTextCompare) > 0 Then
Set myForward = oItem.Forward
myForward.Recipients.Add "derp#derpinacorp.com"
myForward.Importance = olImportanceHigh
'MsgBox "uno momento"
myForward.Send
Else
End If
Else
End If
0:
End Sub
I'm trying to convert an incoming appointment message to email and send.
Public Sub ConvertMeetingToEmail(ActiveFolder, Inbox As String)
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim Subfolder As Outlook.Folder
Dim Item As Object
Dim myMtg As Outlook.MeetingItem
Dim objMsg As MailItem
Set objMsg = Application.CreateItem(olMailItem)
Set myNamespace = Application.GetNamespace("MAPI")
Set myFolder = myNamespace.Folders(ActiveFolder)
Set Folders = myFolder.Folders
Set Subfolder = Folders.Item(Inbox)
For Each Item In Subfolder.Items
If Item.MessageClass = "IPM.Schedule.Meeting.Request" Then
'Convert Appointment to Email and Forward message
'Its Sudo-code and not working
objMsg.To = "example#emp.com"
objMsg.Subject = Item.Subject
objMsg.Body = Item.Body
objMsg.Send
End If
Next
End Sub
It is important to copy body text from Appointment as well as Subject and send to another email address.
I cannot forward this appointment. I have to convert it to email.
UPDATE
I added one line of code and it works:
Set myMtg = Item
objMsg.To = "example#emp.com"
objMsg.Subject = myMtg.Subject
objMsg.Body = myMtg.Body
objMsg.Send
If you want to send an existing meeting item as a regular email you need to set the MessageClass property to IPM.Notefirst. The MessageClass property links the item to the form on which it is based. When an item is selected, Outlook uses the message class to locate the form and expose its properties, such as Reply commands. Then you can cast the object to the MailItem class and call the Send method (of course, after specifying recipients).
At the opposite side, the Forward method of the MeetingItem class executes the Forward action for an item and returns the resulting copy as a MeetingItem object. So, basically a new MeetingItem object that represents the new meeting item is returned which can be sent.
My company assigns each employee an ID which is stored as their 'alias' in Outlook. We use this ID often, and I am looking for an easy way to see it.
Right now I enter the recipient name in a new email, double click the name, click on more options, then Outlook properties. I am looking for a macro that where I would enter the recipient name in a new email, and then run the macro which would just pop up the recipient's alias as a message box (ideally copy it to the clipboard). I have tried (and failed) to write this on my own.
The code I have so far is below. However, this code gives /o=corpexchange/ou=exchange administrative group.....
I am trying to get it to return the alias
Sub ReadRecpDetail2()
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.recipient
Dim recipient As Outlook.recipient
Set myOlApp = GetObject(, "Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
For Each recipient In myItem.Recipients
recipient.Resolve
MsgBox recipient.AddressEntry
Next recipient
End Sub
To Recreate:
Open new outlook email
Enter email address and resolve
Run macro
Try to use the following methods:
Use the CreateRecipient method of the Namespace class to create a Recipient object.
Call the Resolve method of the Recipient class to resolve a Recipient object against the Address Book.
Get the AddressEntry property value, returns the AddressEntry object corresponding to the resolved recipient.
Call the GetExchangeUser method of the AddressEntry class, it returns an ExchangeUser object that represents the AddressEntry if the AddressEntry belongs to an Exchange AddressList object such as the Global Address List (GAL) and corresponds to an Exchange user.
The Alias property of the ExchangeUser class returns a String representing the alias for the ExchangeUser.
You may also find the Getting Started with VBA in Outlook 2010 article helpful.
With all your help I was able to solve this by capturing recipient address entry, adding it as a new item, showing alias, then deleting the recipient:
Sub ReadRecpDetail()
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.mailItem
Dim myRecipient As Outlook.recipient
Dim recipient As Outlook.recipient
Dim SMTPaddress As String
Dim entry As Outlook.AddressEntry
Dim entrystring As String
Dim Copytoclipboard As New DataObject
Set myOlApp = GetObject(, "Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
Set recipient = myItem.Recipients.Item(1)
Set myRecipient = myItem.Recipients.Add(recipient.AddressEntry)
myRecipient.Resolve
entrystring = myRecipient.AddressEntry.GetExchangeUser.Alias
MsgBox (entrystring)
Copytoclipboard.SetText entrystring
Copytoclipboard.PutInClipboard
myRecipient.Delete
End Sub
I had a similar situation where I needed to print out all the user names of the recipients in an email so I could export them to another application. I based my solution off of your answer which is below in case it helps anyone else.
Sub PrintRecipientAliases()
Dim myOlApp As Outlook.Application
Dim myItem As Outlook.MailItem
Dim recipient As Outlook.recipient
Set myOlApp = GetObject(, "Outlook.Application")
Set myItem = myOlApp.ActiveInspector.CurrentItem
For Each recipient In myItem.Recipients
With recipient
Debug.Print recipient.AddressEntry.GetExchangeUser.Alias
End With
Next
End Sub