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
Related
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.
I am creating a VBA Macro in Outlook that will copy an existing meeting invite and create a follow up meeting invite. It should be fairly easy since I have all the parts to this puzzle.
My problem is with the body of the invite; all formatting and pictures are lost. For this reason, I need to use the Word Inspector object to preserve any special formatting and images. I figured out the code using Word and recording a macro.
So I have figured out the code for copying text using the Word Inspector, but I am not sure on how to paste it in another invite.
Sub copyPaste()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
On Error Resume Next
Set objOL = Application
If objOL.ActiveInspector.EditorType = olEditorWord Then
Set objDoc = objOL.ActiveInspector.WordEditor
Set objNS = objOL.Session
Set objSel = objDoc.Windows(1).Selection
objSel.WholeStory
objSel.Copy
objSel.PasteAndFormat (wdFormatOriginalFormatting)
End If
Set objOL = Nothing
Set objNS = Nothing
End Sub
Please see my current Outlook code:
Sub scheduleFollowUpMeeting()
'Declarations
Dim obj As Object
Dim Sel As Outlook.Selection
'Selecting the Email
If TypeOf Application.ActiveWindow Is Outlook.Inspector Then
Set obj = Application.ActiveInspector.currentItem
Else
Set Sel = Application.ActiveExplorer.Selection
If Sel.Count Then
Set obj = Sel(1)
End If
End If
If Not obj Is Nothing Then
MsgBox "The original meeting has been copied." & vbCrLf & "Please kindly update any new details like date/time.", , "Follow Up Meeting - Amit P Shah"
Dim objFollowUp As Outlook.AppointmentItem
Set objFollowUp = Application.CreateItem(olAppointmentItem)
'Copies existing details from original Invite
With objFollowUp
.MeetingStatus = olMeeting
.Subject = "Follow Up: " & obj.Subject
.Body = obj.Body
.Start = Now + 1 'Takes today's date and adds 1 day
.End = DateAdd("n", obj.Duration, .Start)
'Other
.AllDayEvent = obj.AllDayEvent
.BusyStatus = obj.BusyStatus
.Categories = obj.Categories
.Companies = obj.Companies
.ForceUpdateToAllAttendees = obj.ForceUpdateToAllAttendees
.Importance = obj.Importance
.Location = obj.Location
.OptionalAttendees = obj.OptionalAttendees
.ReminderMinutesBeforeStart = obj.ReminderMinutesBeforeStart
.ReminderOverrideDefault = obj.ReminderOverrideDefault
.ReminderPlaySound = obj.ReminderPlaySound
.ReminderSet = obj.ReminderSet
.ReminderSoundFile = obj.ReminderSoundFile
.ReplyTime = obj.ReplyTime
.RequiredAttendees = obj.RequiredAttendees
.Resources = obj.Resources
.ResponseRequested = obj.ResponseRequested
.Sensitivity = obj.Sensitivity
.UnRead = obj.UnRead
.Display
End With
End If
End Sub
Any help would greatly be appreciated. Many thanks in advance!
I'm not a specialist on this subject but i used to work and manipulate Outlook's AppointmentItem in C# and that's how i see the thing.
Actually, if you try to copy the body of a meeting on another meeting, like you said, you will lose all the special formating, images, etc.
The new body will only contain the caracters without format.
I think you can't put formatted text on the body property, you have to use the rtfbody property or like you did when you copy the body of your original appointment, use the WordEditor property in the Inspector object.
So, try to use the WordEditor of the new Item you're creating (like you did to take the original content) and to add content in it.
That's what i had to do for putting formatted text in the body of an AppointmentItem in C#.
I did something like that :
Word.Document myDoc = myItem.GetInspector.WordEditor;
Word.Paragraphs paragraphs = myDoc.Content.Paragraphs;
Word.Paragraph para = paragraphs.Add();
para.Range.Text = yourFormattedTextHere;
After that, you may need to release the variables created, but i'm not sure about that.
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.
My VBA experience is incredibly limited.I have created basic macros for excel primarily by frankensteining multiple macros I find online together.
Here's what I am looking to do. Every morning I send out an email to a list of 200 customers, I open the new message from a list and the message auto populates (as it is a signature). Currently I then go through all these emails and add my subject and BCC. Could I possibly create a macro to open all of these emails, add my BCC, add my subject, and then send the emails.
Any and all help is much appreciated.
The following code defines an instance of Outlook.Application, and sets up a MailItem ready for sending. It uses a Dictionary object called EmailData to hold the various bits of info to populate To, BCC etc but those can be replaced with your own strings etc. I've pulled this from a function I wrote and made it a little more generic:
Public Function OL_SendMail()
Dim bOpenedOutlook, sComputer, iLoop, iAccount, sAttachArray, sAttachment
bOpenedOutlook = False
sComputer = "."
Dim oWMIService : Set oWMIService = GetObject("winmgmts:\\" & sComputer & "\root\cimv2")
Dim colItems : Set colItems = oWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'outlook.exe'")
Dim oOutlook : Set oOutlook = CreateObject("Outlook.Application")
Dim oNamespace : Set oNamespace = oOutlook.GetNamespace("MAPI")
If colItems.Count = 0 Then
' Outlook isn't open, logging onto it...
oNamespace.Logon "Outlook",,False,True
bOpenedOutlook = True
End If
Dim oFolder : Set oFolder = oNamespace.GetDefaultFolder(olFolderInbox)
If EmailData("SendFrom") = "" Then
' default to first email account the user has access to
iAccount = 1
Else
' Checking to see if the account to send from is accessible by this user...
iAccount = 0
For iLoop = 1 To oOutlook.Session.Accounts.Count
If UCase(Trim(oOutlook.Session.Accounts.Item(iLoop))) = UCase(Trim(EmailData("SendFrom"))) Then
iAccount = iLoop
Exit For
End If
Next
If iAccount = 0 Then
sErrorMsg = "Cannot send email from specified account: " & EmailData("SendFrom") & " as this user doesn't appear to have access to it in Outlook!"
OL_SendMail = False
Exit Function
End If
End If
Dim oMailItem : Set oMailItem = oOutlook.CreateItem(olMailItem)
With oMailItem
Set .SendUsingAccount = oOutlook.Session.Accounts.Item(iAccount)
.To = EmailData("To")
.CC = EmailData("CC")
.BCC = EmailData("BCC")
.Subject = EmailData("Subject")
.Body = EmailData("Body")
sAttachArray = Split(EmailData("AttachmentPaths"), ";")
For Each sAttachment In sAttachArray
.Attachments.Add(sAttachment)
Next
.Recipients.ResolveAll
.Display ' debug mode - uncomment this to see email before it's sent out
End With
'Mail Item created and ready to send
'oMailItem.Send ' this is commented out so the mail doesn't auto send, allows checking of it!!
Set oMailItem = Nothing
Set oNamespace = Nothing
If bOpenedOutlook Then
'oOutlook.Quit
End If
Set oOutlook = Nothing
Set colItems = Nothing
Set oWMIService = Nothing
OL_SendMail = True
End Function
I have created a rule that executed when outlook receives an mail and it will create the appointment on outlook calendar. In that I need to get the date and time mentioned in the mail as the appointment date.
Sub NewMeetingRequestFromEmail(email As MailItem)
Dim app As New Outlook.Application
Dim meetingRequest As AppointmentItem
Set meetingRequest = app.CreateItem(olAppointmentItem)
meetingRequest.Categories = email.Categories
meetingRequest.Body = email.Body
meetingRequest.Subject = email.Subject
meetingRequest.Location = email.Subject
meetingRequest.Start = DateSerial(Year(Now), Month(Now), Day(Now) + 1) + #10:00:00 AM#
meetingRequest.Duration = 60
meetingRequest.ReminderMinutesBeforeStart = 45
meetingRequest.ReminderSet = True
Dim attachment As attachment
For Each attachment In email.Attachments
CopyAttachment attachment, meetingRequest.Attachments
Next attachment
Dim recipient As recipient
Set recipient = meetingRequest.Recipients.Add(email.SenderEmailAddress)
recipient.Resolve
For Each recipient In email.Recipients
RecipientToParticipant recipient, meetingRequest.Recipients
Next recipient
Dim inspector As inspector
Set inspector = meetingRequest.GetInspector
'inspector.CommandBars.FindControl
inspector.Display
meetingRequest.Save
End Sub
Private Sub RecipientToParticipant(recipient As recipient, participants As Recipients)
Dim participant As recipient
If LCase(recipient.Address) <> LCase(Session.CurrentUser.Address) Then
Set participant = participants.Add(recipient.Address)
Select Case recipient.Type
Case olBCC:
participant.Type = olOptional
Case olCC:
participant.Type = olOptional
Case olOriginator:
participant.Type = olRequired
Case olTo:
participant.Type = olRequired
End Select
participant.Resolve
End If
End Sub
Private Sub CopyAttachment(source As attachment, destination As Attachments)
On Error GoTo HandleError
Dim filename As String
filename = Environ("temp") & "\" & source.filename
source.SaveAsFile (filename)
destination.Add (filename)
Exit Sub
HandleError:
Debug.Print Err.Description
End Sub
The Outlook object model provides three main ways for working with item bodies:
Body.
HTMLBody.
The Word editor. The WordEditor property of the Inspector class returns an instance of the Word Document which represents the message body.
See Chapter 17: Working with Item Bodies for more information.