I have some code that partially populates an email message as a reply. But I can not get the sender unless they are on (an / our)? exchange server.
Public Sub CreateMessage()
Dim EmailFrom As String
Dim NewMessage As Outlook.MailItem
Dim OldMessage As Outlook.MailItem
Set OldMessage = Application.ActiveInspector.CurrentItem
Set NewMessage = Application.CreateItem(olMailItem)
EmailFrom = OldMessage.Sender.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x39FE001E")
NewMessage.Body = Body(EmailFrom)
NewMessage.HTMLBody = HTMLBody(EmailFrom)
NewMessage.Recipients.Add (EmailFrom)
NewMessage.Display
Set NewMessage = Nothing
End Sub
The message I receive is "The property "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" is unknown or cannot be found." and it only appears to work with internal messages.
Anyone know of a way in Outlook VBA to get the sender of a mail message that works for all of them?
Fixed based on Dimitry's comments:
Public Sub CreateMessage()
Dim EmailFrom As String
Dim NewMessage As Outlook.MailItem
Dim OldMessage As Outlook.MailItem
Set OldMessage = Application.ActiveInspector.CurrentItem
Set NewMessage = Application.CreateItem(olMailItem)
Select Case OldMessage.SenderEmailType
Case "EX"
EmailFrom = OldMessage.Sender.GetExchangeUser.PrimarySmtpAddress
Case Else
EmailFrom = OldMessage.SenderEmailAddress
End Select
NewMessage.Body = Body(EmailFrom)
NewMessage.HTMLBody = HTMLBody(EmailFrom)
NewMessage.Recipients.Add (EmailFrom)
NewMessage.Display
Set NewMessage = Nothing
End Sub
You are requesting the PR_SMTP_ADDRESS property, which is Exchange specific. Check if SenderEmailType is "EX" and only then read the PR_SMTP_ADDRESS property. Otherwise just read the MailItem.SenderEmailAddress property.
Take a look at the message with OutlookSpy (I am its author - click IMessage) to see the available properties.
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.
This sends an automatic email the by user who uses the program, but I want an email to be sent from the same email address no matter who uses it.
Here my code. Could you help me please ?
Dim msgBody
Dim thresholdInfo
Dim receipAddress
'msgBody=""+vbNewLine
thresholdInfo="xxx :"+CStr(Threshold.StatValue)+vbNewLine+vbNewLine
receipAddress="xx"
cc="xx"
SendMail receipAddress,msgBody+thresholdInfo,"xxxxxx"
Sub SendMail(recipient,msg,subject)
Dim objOutlook
Dim objOutlookMsg
Set objOutlook = CreateObject( "Outlook.Application" )
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
objOutlookMsg.To = recipient
objOutlookMsg.Cc = cc
objOutlookMsg.Subject = subject
objOutlookMsg.Body = msg
objOutlookMsg.Importance = Low
objOutlookMsg.Send
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
Have you tried declaring the Sender first:
Dim Sender As Outlook.AddressEntry
Sender.Address = "your#email.com"
Then finally including it in your Sub SendMail(recipient,msg,subject):
objOutlookMsg.Sender = Sender
More info here: https://learn.microsoft.com/en-us/office/vba/api/outlook.mailitem.sender
I'm using VB.NET and creating a new Mail outlook item using Microsoft.Interop.Outlook ver#15.
I can create an Email object and set the Subject, Body, ToAddress, ccAddress, etc. just fine and display the new Email.
I am having issues when I try and add a .pdf file via file path string to Attachments using the .Add method. Get an error "Sorry something went wrong.. " I have moved the file into different folders locally and same error.
Dim oApp As Outlook.Application = New Outlook.Application
Dim mailItem As Outlook.MailItem = oApp.CreateItem(Outlook.OlItemType.olMailItem)
mailItem.Subject = _sSubject
mailItem.To = sToAddress
mailItem.CC = sCCAddress
mailItem.Body = sBody
''Commented out for now Until I can figure out error!!
For Each _File As String In sAttachList
Dim _AttachObject As New System.Net.Mail.Attachment(_File)
mailItem.Attachments.Add(_AttachObject)
Next
mailItem.Importance = Outlook.OlImportance.olImportanceNormal
mailItem.Display(True)
mailItem = Nothing
oApp = Nothing
I think, this line is the problem:
Dim _AttachObject As New System.Net.Mail.Attachment(_File)
Why not just add the absolute file paths? So this one should do it:
For Each _File As String In sAttachList
mailItem.Attachments.Add(_File)
Next
I use this functions:
Private Function Correct(Value As String) As String
If Value = "" Then Return Value
Return Value.Trim.Replace(",", ";").Replace(" ", "")
End Function
Private Sub AddAttachments(ByRef Mail As Outlook.MailItem, Attachments As String())
If Attachments Is Nothing OrElse Attachments.Count = 0 Then Return
For Each Attachment As String In Attachments
Mail.Attachments.Add(Attachment)
Next
End Sub
Public Sub SendMail(Receiver As String,
Subject As String,
Body As String,
Optional CC As String = "",
Optional BCC As String = "",
Optional Attachments As String() = Nothing)
Receiver = Correct(Receiver)
If Receiver = "" Then Return
Dim Mail As Outlook.MailItem = CType(OUT.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)
With Mail
.To = Receiver
.Subject = Subject.Trim
.Body = Body.Trim
.CC = Correct(CC)
.BCC = Correct(BCC)
AddAttachments(Mail, Attachments)
If MyAccount IsNot Nothing Then .SendUsingAccount = MyAccount
If MySentFolder IsNot Nothing Then .SaveSentMessageFolder = MySentFolder
.Send()
End With
Mail = Nothing
End Sub
These are functions in a Outlook class, so some objects need explanation:
OUT is an openend Outlook.Application object
MyAccount is an Outlook.Account object. You can use it to send the mail with another account than the default
MySentFolder is an Outlook.Folder object. You can use it, if you want to store the sent mail in another folder than the default sent folder.
Surely you can omit these two lines in the code.
So I have multiple mailboxes under my Outlook account and I am trying to get them to generate reply template based on the mailbox I am replying from (one is private, one is shared). I have tried to base the condition on SenderName and SenderEmailAddress, but to no avail (reply email gets generated with the contents of the previous email retrieved but the text I intend to put in front of it is not there; the cause is that the value of oReply.SenderEmailAddress is empty as Else clause will write the stuff as intended).
(and yes, there are snippets from code enabling reply with attachments)
Sub ReplyWithAttachments()
Dim oReply As Outlook.MailItem
Dim oItem As Object
Dim sSignature As String
Set oItem = GetCurrentItem()
If Not oItem Is Nothing Then
Set oReply = oItem.Reply
If oReply.SenderEmailAddress = "mailbox.private#something.com" Then
sSignature = "Hello and welcome!"
ElseIf oReply.SenderEmailAddress = "mailbox.shared#something.com" Then
sSignature = "Go to hell!"
End If
CopyAttachments oItem, oReply
oReply.HTMLBody = sSignature & oReply.HTMLBody
oReply.Display
oItem.UnRead = False
End If
Set oReply = Nothing
Set oItem = Nothing
End Sub
Edit:
so I managed to get somewhere with
Set oReply = oItem.Reply
sMailBox = oReply.Sender.GetExchangeUser.Address
If sMailBox = "mailbox.private#something.com" Then
sSignature = "whatever"
ElseIf sMailBox = "mailbox.shared#something.com" Then
sSignature = "bla bla bla"
Else
sSignature = "Something"
The code works as intended for the shared mailbox but for the private one, it errors out with Object variable or With block variable not set pointing to .Sender
sMailBox = oReply.Sender.GetExchangeUser.Address
I have something that I use to get sender email (as its dependent on your email exchange)
Dim strSendersEmailAddress As String
If oItem.SenderEmailType = "EX" Then
strSendersEmailAddress = oItem.Sender.GetExchangeUser.PrimarySmtpAddress
Else
strSendersEmailAddress = oItem.SenderEmailAddress
End If
You will have to get the email address before you Set oReply = oItem.Reply
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.