I've written a macro in Excel to send calendar invites (appointments) via Outlook. The recipients must be bcc'd (added to Resources field).
I have text in the body of the calendar appointment. It appears that by utilizing the WordEditor in combination with bcc/resources, I get an alert pop-up before each send: "Do you want to update the location to...?"
I do not want to update/change the location, as it would get replaced by the recipient list, thus defeating the reason for bcc (recipients would see Location as the entire recipient list).
If I remove the code block that adds text to the body (starting with "Set ActInsp..."), then this alert does not appear, and everything else works correctly; however, I need the text body with a hyperlink.
gif of how to duplicate the "Update Location" alert manually.
Below is a working sample of the macro. The code block with WordEditor appears toward the bottom, right above .Display.
Be sure to add the Reference: Microsoft Outlook 16.0 Object Library (I failed to get late binding to work).
Sub SendAppointments_SingleEmail()
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
'Requires early binding (late binding not working):
' Go to the Tools menu, Resources. Add Microsoft Outlook 16.0 Object Library
'Because AppointmentItem does not use HTML, must utilize Word VBA
Dim ActInsp As Outlook.Inspector
'Static fields
emailFrom = "test#gmail.com"
emailSubject = "My Subject"
emailBody = "Body of calendar invite"
hyperlink = "https://www.register.com/"
emailLocation = "My Location"
appt_Date = #7/30/2019#
appt_Time = #3:00:00 PM#
appt_Duration = "90"
'Create Appointment and Send
Set myAppt = olApp.CreateItem(olAppointmentItem)
With myAppt
.MeetingStatus = olMeeting
.SendUsingAccount = emailFrom
.Subject = emailSubject
.Location = emailLocation
.Start = appt_Date & " " & appt_Time
.Duration = 90
Set myResourceAttendee = .Recipients.Add("test1#test.com")
myResourceAttendee.Type = olResource 'Add as a Resource/BCC
Set ActInsp = myAppt.GetInspector
With ActInsp
.WordEditor.Characters(1).InsertBefore (emailBody & vbNewLine & vbNewLine & hyperlink)
.Close (olSave)
End With
.Display
'.Send
End With 'myAppt
End Sub
Instead of Closing the Object from ActInsp, Close the myAppt object.
So change this part of your code:
With ActInsp
.WordEditor.Characters(1).InsertBefore (emailBody & vbNewLine & vbNewLine & hyperlink)
.Close (olSave)
End With
.Display
'.Send
With:
With ActInsp
.WordEditor.Characters(1).InsertBefore (emailBody & vbNewLine & vbNewLine & Hyperlink)
'.Close (olSave)
End With
.Display
.Close (olSave)
'.Send
Related
I've been trying to write a macro in VBA to send an e-mail to the users of the excel after the document has been edited and saved. To make it clear let's say Person 1 edited the document by changing cell C4 and F6 etc. After Person 1 clicked save I want this macro to trigger and send an e-mail to every user that use this document so there won't be any need for anyone to write or say everyone what they changed. I am a mechanical engineer and have no background in coding. I managed the part where macro triggers after document has been saved which is the easy part but I can't add which cell(s) edited in the mail body. Here is what I did. I am looking for your help.
Note: The code is in display rn bcs I dont want to get useless mails just to try if it works or not.
Public Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Send_Email
End Sub
Public Sub Send_Email()
Dim username As Namespace
Dim olMail As MailItem
Set username = GetNamespace("MAPI")
Set olMail = CreateItem(olMailItem)
With olMail
.Subject = "Excel File " & ThisWorkbook.Name & " Modified by " & Application.username
.To = "***#***.com; "
.Body = "Excel file " & ThisWorkbook.FullName & " at" & " was modified by " & Application.username & " on " & Format(Now(), "mm-dd-yyyy") & " at " & Format(Now(), "hh:mm:ss AM/PM") & "."
.SendUsingAccount = username.Accounts.Item(1)
.Display
End With
Set olMail = Nothing
Set username = Nothing
End Sub
I have an excel spreadsheet for permits, and one column is their expiration dates. My boss wants to be emailed about the permits that expire in the next 2 weeks. How can I use visual basic to tell Outlook to send an email each time he opens the excel spreadsheet?
This is for a spreadsheet I set up, permit names are in column A, dates are in column J.
Sub Mail_small_Text_Outlook()
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Hi there" & vbNewLine & vbNewLine & _
"Cell A1 is changed" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With OutMail
.To = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I may have to use a button to run the program, but I'm not sure if it is possible to schedule emails.
It appears that you have not dimmed OutApp as an object.
Once that is done add a loop examining the expiration dates and adding the specific cells to a dynamic array, re-dimming the array with each iteration. Finally each license on the array will need to be added to a text string that can then be added to the body of the email you are creating above....
Once you have all the above working as you would like, you will want to tie the whole operation to the Workbook Open event.
In the VBE, open This Workbook...
Then use the drop-down menus to select the Workbook and Open Event and add your code and save.
I am new in VBA. I would like to ask on how to trigger email which has been reply.
Scenario : I have this coding as below which send the email to recipient (Column B) if there is "yes" in column C.
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & Cells(cell.Row, "A").Value _
& vbNewLine & vbNewLine & _
"Please contact us to discuss bringing " & _
"your account up to date"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'Or use Display
End With
Question : How can I trigger if the recipient has replied to my email that I sent earlier? I would like to automate the trigger to my excel file on column E as remark recipient has replied to my email. Ex, "replied / no reply".
Really appreciate for any help since I am new in VBA.
Thank you.
Assuming your using Microsoft Outlook and an Exchange Server.
There are 3 Extended MAPI properties that deal with the message state for replied to/forwarded:
PR_ICON_INDEX (0x10800003)
PR_LAST_VERB_EXECUTED (0x10810003)
PR_LAST_VERB_EXECUTION_TIME (0x10820040)
This MSDN article https://msdn.microsoft.com/en-us/library/bb176395(office.12).aspx provides code that shows how to use these MAPI Properties:
Sub DemoPropertyAccessorGetProperty()
Dim PropName, Header As String
Dim oMail As Object
Dim oPA As Outlook.PropertyAccessor
'Get first item in the inbox
Set oMail = _
Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
'PR_TRANSPORT_MESSAGE_HEADERS
PropName = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
'Obtain an instance of PropertyAccessor class
Set oPA = oMail.PropertyAccessor
'Call GetProperty
Header = oPA.GetProperty(PropName)
Debug.Print (Header)
End Sub
You will want to replace the 'PR_TRANSPORT_MESSAGE_HEADERS ie 0x007D001E in the above code and I'm guessing you'll want to go through more than just the first mail item...
I'm trying to figure out a way to detect whether or not the user clicks "Send" in the Outlook application that is displayed. I've tried reading the value of .Display similarly to how one would detect user input when using the FileDialog application (someInt = .Show), to no avail. I can't find any documentation on the Outmail Application, so any help would be greatly appreciated.
Set olApp = CreateObject("Outlook.Application")
Set Outmail = olApp.CreateItem(olMailItem)
With Outmail
.To = clientEmail
.CC = projectManagerEmail
.BCC = ""
.Subject = projectName & " (PO # " & poNumber & ", Job #" & projectNumber & ") - " & fileType & " (" & fileName & ")"
.Attachments.Add ActiveWorkbook.Path & "\" & fileType & "\" & folderName & "\" & fileName & ".pdf"
.Display
.Save
End With
I believe you need to intercept the Send operation in Outlook.
In Outlook, go to VBA Editor (Alt-F11), then paste below into the ThisOutlookSession under Microsoft Outlook Objects.
Make sure your operations works in Outlook, then close Outlook. You may have to Sign the code, change Macro Security Settings depending on your environment. Value of Cancel is what determines if the user has clicked Send (e.g. clicked -> Cancel=False).
Since there is no direct way to get the value of Cancel, may be you have to create a unique text file in local temp folder and pick it up in Excel to indicate it is Sent.
Private Sub Application_ItemSend(ByVal oItem As Object, Cancel As Boolean)
' Add Operations or Sub calls here
MyCheck01 oItem, bCancel
End Sub
Private Sub MyCheck01(ByVal oItem As Object, Cancel As Boolean)
' Do operations here. If Send is to be aborted, set Cancel to True.
End Sub
You will also need to define this olMailItem in Excel (Const olMailItem = 0).
I am trying to write some VB code within Excel 2007 that will automatically send out meeting invites from the Outlook 2007 Calendar, to a list of addressees listed in the excel spreadsheet, on the dates specified within the spreadsheet. This is useful because I can send out hundreds of meeting requests to different people on different dates with one click of a button. I can do this fine when sending from my own user account with the following code:
' Create the Outlook session
Set myoutlook = CreateObject("Outlook.Application")
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem) ' Set the appointment properties
With myapt
.Subject = " Assessment Centre "
.Location = "conference room A"
.Start = Cells(5, 24 + j) & " 17:00:00 PM"
.Duration = 120
.Recipients.Add Cells(i, 1).Value
.MeetingStatus = olMeeting
' not necessary if recipients are email addresses
'myapt.Recipients.ResolveAll
.AllDayEvent = "False"
.BusyStatus = "2"
.ReminderSet = False
.Body = L1 & vbCrLf & vbCrLf & L2 & vbCrLf & vbCrLf & L3 & vbCrLf & vbCrLf & L4
.Save
.send
End With
But now I want to send the meeting request from a dummy user account for which I am a delegate using something like ’sendonbehalfof’ so that the dummy calendar stores all the meeting invites, and other delegates can operate the system as well using the same dummy user account. This works fine when sending an email with the following code:
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = " John.Smith#John_Smith.com "
.Subject = "Subject"
.Body = "Body"
.SentOnBehalfOfName = "Fred.bloggs#fred_blogs.com"
.send
End With
The email will say from ’me on behalf of Fred Bloggs’
But I can’t get it to work with Calendar appointments.
I’ve searched high and low with words like ‘appointment’, ‘meeting request’, sendonbehalfof’ etc, and it seems you should be able to do this for appointments with ’sendusingaccount’ but this doesn’t seem to work (it doesn’t fail, just ignores the instruction and sends from my own user account as before).
Can anyone tell me how to do this?
Thanks very much.
If you have delegate access to another user's mailbox, use GetSharedDefaultFolder to obtain a reference to the user's shared calendar, then use Folders.Items.Add to add the meeting to their calendar.
Ex:
Dim fldr As Outlook.Folder
Dim appt As Outlook.AppointmentItem
Set fldr = Session.GetSharedDefaultFolder(_
Outlook.CreateRecipient("Fred.bloggs#fred_blogs.com"), _
olFolderCalendar)
Set appt = fldr.Items.Add
' set up your appointment here
' i.e.:
' With appt
' .Start = Cells(5, 24 + j) & " 17:00:00 PM"
' .Duration = 120
' End With
' make sure you call the appt.Save method to save the appt!
Adapted from: http://www.outlookcode.com/codedetail.aspx?id=43