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).
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'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
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 send an email with VBA. A classification is popped up for each email and it needs to be set by hand. I am trying to work around this in the code.
I found a code to send emails: Mail a message with outlook via VBA.
After fixing few things, the following code is working.
Sub sendEmail()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Application.EnableEvents = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
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 Finish your course " & Cells(cell.Row, "C") & _
" before expiry date."
.Send 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
The problem is that after sending emails from the list to for example 10 persons, I need to click on classification pop up 10 times.
I found this: How to save workbook and handle TITUS (or any other document classification add-in) popup?
I tried .EnableEvents = False before .Send. I am not sure if this does serve me.
How to use this in my case? Is it doable to disable it, work around it, or even set a classification within the code?
There is a workaround, but you have to do it in Outlook Developer itself. You can set up an event handler in Outlook which triggers a macro. So, in this case, Outlook could watch for a message to be created with a specific subject line (as an example), and THAT would trigger the script below, which bypasses TITUS.
'Sets Titus Mail settings and sends mail
With AOMailMsg
objMsg.ItemProperties.Add("ABCDE.Registered To", olText) = "My Companies"
objMsg.ItemProperties.Add("ABCDE.Classification", olText) = "Internal"
objMsg.UserProperties.Add("ABCDE.Registered To", olText) = "My Companies"
objMsg.UserProperties.Add("ABCDE.Classification", olText) = "Internal"
objMsg.UserProperties.Add("TITUSAutomatedClassification", olText) = _
"TLPropertyRoot=ABCDE;.Registered To=My Companies;.Classification=Internal;"
objMsg.Send
End With
I wrote an Excel macro to send email from a spreadsheet. It works on Office 2013, but not Office 2016.
I looked at the VBA differences between Office 2013 and 2016, but couldn't see anything about changes to the inspector or word editor for message objects.
Once it gets to .GetInspector.WordEditor it throws:
Run-time error '287':
Application-defined or object defined error
Here is the relevant part of the macro:
Sub SendEmail()
Dim actSheet As Worksheet
Set actSheet = ActiveSheet
'directories of attachment and email template
Dim dirEmail as String, dirAttach As String
' Directory of email template as word document
dirEmail = _
"Path_To_Word_Doc_Email_Body"
' Directories of attachments
dirAttach = _
"Path_To_Attachment"
' Email Subject line
Dim subjEmail As String
subjEmail = "Email Subject"
Dim wordApp As Word.Application
Dim docEmail As Word.Document
' Opens email template and copies it
Set wordApp = New Word.Application
Set docEmail = wordApp.Documents.Open(dirEmail, ReadOnly:=True)
docEmail.Content.Copy
Dim OutApp As Outlook.Application
Set OutApp = New Outlook.Application
Dim OutMail As MailItem
Dim outEdit As Word.Document
' The names/emails to send to
Dim docName As String, sendEmail As String, ccEmail As String, siteName As String
Dim corName As String
Dim row As Integer
For row = 2 To 20
sendName = actSheet.Cells(row, 1)
sendEmail = actSheet.Cells(row, 2)
ccEmail = actSheet.Cells(row, 3)
siteName = actSheet.Cells(row, 4)
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
.To = sendEmail
.CC = ccEmail
.Subject = subjEmail & " (Site: " & siteName & ")"
Set outEdit = .GetInspector.WordEditor
outEdit.Content.Paste
outEdit.Range(0).InsertBefore ("Dear " & sendName & "," & vbNewLine)
.Attachments.Add dirAttach
.Display
'.Send
End With
Debug.Print row
Set OutMail = Nothing
Set outEdit = Nothing
Next row
docEmail.Close False
wordApp.Quit
End Sub
Things I've tried based on suggestions:
Checked Outlook settings - default is HTML text
Moved .display over .GetInspector.WordEditor
Ensure Word is the default email editor. From the Inspector.WordEditor dox:
The WordEditor property is only valid if the IsWordMail method returns True and the EditorType property is olEditorWord . The returned WordDocument object provides access to most of the Word object model...
Further, ensure that Outlook is configured to send Rich Text or HTML emails, not plain text.
I am not entirely sure if I had the same issue as you, but the call to GetInspector started failing for me after upgrading Office 2016. So to be clear it worked with Office 2016 and then stopped working after the latest update.
The following workaround worked for me
dim item : set item = Addin.Outlook.CreateItemFromTemplate(Filename)
Outlook.Inspectors.Add(item) ' Outlook is the application object
it only appears to work if I add the item straight after creating it, setting properties on it and then adding it did not work.
Note: I have not tested with CreateItem instead of CreateItemFromTemplate. The second line was added and unnecessary prior to the Office update.
Problem:
For security purposes, the HTMLBody, HTMLEditor, Body and WordEditor properties all are subject to address-information security prompts because the body of a message often contains the sender's or other people's e-mail addresses. And, if Group Policy does not permit then these prompts do not come on-screen. In simple words, as a developer, you are bound to change your code, because neither registry changes can be made nor group policy can be modified.
Hence, if your code suddenly stopped working after migrating to Office 365 or for any other reasons, please refer to the solutions below. Comments have been added for easy understanding and implementation.
Solution 1:
If you have administrative rights then try the registry changes given at below link:
https://support.microsoft.com/en-au/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo
However, as developer, I recommend a code that's rather compatible with all versions of Excel instead of making system changes because system changes will be required on each end user's machine as well.
Solution 2: VBA Code
Code Compatible: Excel 2003, Excel 2007, Excel 2010, Excel 2013, Excel 2016, Office 365
Option Explicit
Sub Create_Email(ByVal strTo As String, ByVal strSubject As String)
Dim rngToPicture As Range
Dim outlookApp As Object
Dim Outmail As Object
Dim strTempFilePath As String
Dim strTempFileName As String
'Name it anything, doesn't matter
strTempFileName = "RangeAsPNG"
'rngToPicture is defined as NAMED RANGE in the workbook, do modify this name before use
Set rngToPicture = Range("rngToPicture")
Set outlookApp = CreateObject("Outlook.Application")
Set Outmail = outlookApp.CreateItem(olMailItem)
'Create an email
With Outmail
.To = strTo
.Subject = strSubject
'Create the range as a PNG file and store it in temp folder
Call createPNG(rngToPicture, strTempFileName)
'Embed the image in Outlook
strTempFilePath = Environ$("temp") & "\" & strTempFileName & ".png"
.Attachments.Add strTempFilePath, olByValue, 0
'Change the HTML below to add Header (Dear John) or signature (Kind Regards) using newline tag (<br />)
.HTMLBody = "<img src='cid:DashboardFile.png' style='border:0'>"
.Display
End With
Set Outmail = Nothing
Set outlookApp = Nothing
Set rngToPicture = Nothing
End Sub
Sub createPNG(ByRef rngToPicture As Range, nameFile As String)
Dim wksName As String
wksName = rngToPicture.Parent.Name
'Delete the existing PNG file of same name, if exists
On Error Resume Next
Kill Environ$("temp") & "\" & nameFile & ".png"
On Error GoTo 0
'Copy the range as picture
rngToPicture.CopyPicture
'Paste the picture in Chart area of same dimensions
With ThisWorkbook.Worksheets(wksName).ChartObjects.Add(rngToPicture.Left, rngToPicture.Top, rngToPicture.Width, rngToPicture.Height)
.Activate
.Chart.Paste
'Export the chart as PNG File to Temp folder
.Chart.Export Environ$("temp") & "\" & nameFile & ".png", "PNG"
End With
Worksheets(wksName).ChartObjects(Worksheets(wksName).ChartObjects.Count).Delete
End Sub
Try moving the editor to the first action...
...
With OutMail
Set outEdit = .GetInspector.WordEditor
outEdit.Content.Paste
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
.To = sendEmail
.CC = ccEmail
.Subject = subjEmail & " (Site: " & siteName & ")"
...