I am using MS Excel and Outlook 2013. I am trying to automate an Excel spreadsheet that sends 5 emails to a specified address using Outlook.
The trick is I want each message to display one at a time and only move on to the next message when the user either hits Send or closes the message. Here is what I have so far:
Sub Send_Emails()
Dim OutApp As Object: Set OutApp = CreateObject("Outlook.Application")
Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)
'Send Email
With OutMail
.to = "john.doe#mycompany.com"
.Subject = "This is the Subject"
.Body = "This is message"
.Display
End With
On Error Resume Next:
OutMail = Nothing
OutApp = Nothing
End Sub
Sub Send_Five_Emails()
For i = 1 To 5 'Send email 5 times
Call Send_Emails
Next i
End Sub
The problem with this code is that it displays all 5 message windows at once. Is there a way to make the Close event of one message window trigger the Displaying of the next one, so as to make them appear one at a time?
I appreciate the help.
Use .Display (True)
The expression.Display(Modal) argument is used with all objects except for the Explorer and MAPIFolder objects, True to make the window modal. The default value is False.
See Display Method on MSDN
Related
I am trying to modify the HTML body of an Outlook email, based on a template, from Excel VBA.
My code is:
Sub Email_Button()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate("S:\some\path\to\file\Email.oft")
With OutMail
.Importance = olImportanceHigh
.Subject = "Subject " & Date
.Attachments.Add Application.ActiveWorkbook.FullName
.HTMLBody = WorksheetFunction.Substitute(OutMail.HTMLBody, "%target%", "replacement")
.Display
End With
' *** TIDY UP ***
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
The question is very similar to this.
I get
Run Time Error 287. Application-defined or object-defined error
on the .HTMLBody modification line.
If I remove this line the email is displayed for the user to check before hitting send.
I have referenced the Microsoft Outlook 15 Object Library.
I added:
With OutMail
.bodyFormat = olFormatHTML
But got the same error on the Substitute line so I changed the substitute to:
.HTMLBody = "<HTML><BODY>Some HTML text here</BODY></HTML>"
And the body of the email was updated.
So the error is only present when trying to use substitute or its to do with the oft.
It looks like from the debugger that there is no HTML body:
I have confirmed that body type is set to HTML both programmatically:
and by opening the oft message and checking:
The cause of the issue can be related to the Substitute method, so I'd suggest running the following code to make sure everything works correctly:
Sub CreateHTMLMail()
Dim OutApp As Outlook.Application
Set OutApp = CreateObject("Outlook.Application")
'Creates a new email item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create email item
Set objMail = OutApp.CreateItemFromTemplate("S:\some\path\to\file\Email.oft")
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
Another aspect is Outlook security prompts. Read more about that in the "A program is trying to send an e-mail message on your behalf" warning in Outlook article.
The most probable cause is Outlook Security.
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.
You can find the security configurations in HKCU\Software\Policies\Microsoft\office\16.0\outlook\security\
(change 16.0 to your office version)
There are two values that you can check, promptoomaddressbookaccess and promptoomaddressinformationaccess
Change them to 2 (or ask your system administrator), restart Outlook and try again.
More info https://support.microsoft.com/en-za/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo
I've spent the last couple days trying to figure this out, I've managed to stop all the errors, however the email doesn't show up in my inbox. I've tried to change everything up and still it doesn't show up.
The main purpose is to send an entire workbook to an email with a button (I've binded the button to the macro)
Anyways, here's the code I have already
Sub Send_mail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "example#email.com"
.From = "example#email.com"
.CC = ""
.BCC = ""
.Subject = "Assunto"
.Body = "Corpo"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
(ps I did change the email to post this, it's not what I have in the code)
Please remove .From = "example#email.com"
Mail will go with attachment from outlook default mail address.
In Microsoft Documentation From is not listed while To, cc, BCC etc are included . So syntax wise it is wrong. It works for me after removing .From
You can see from list below
Methods
Properties
Actions
AlternateRecipientAllowed
Application
Attachments
AutoForwarded
AutoResolvedWinner
BCC
BillingInformation
Body
BodyFormat
Categories
CC
Class
Companies
Conflicts
ConversationID
ConversationIndex
ConversationTopic
CreationTime
DeferredDeliveryTime
DeleteAfterSubmit
DownloadState
EntryID
ExpiryTime
FlagRequest
FormDescription
GetInspector
HTMLBody
Importance
InternetCodepage
IsConflict
IsMarkedAsTask
ItemProperties
LastModificationTime
MarkForDownload
MessageClass
Mileage
NoAging
OriginatorDeliveryReportRequested
OutlookInternalVersion
OutlookVersion
Parent
Permission
PermissionService
PermissionTemplateGuid
PropertyAccessor
ReadReceiptRequested
ReceivedByEntryID
ReceivedByName
ReceivedOnBehalfOfEntryID
ReceivedOnBehalfOfName
ReceivedTime
RecipientReassignmentProhibited
Recipients
ReminderOverrideDefault
ReminderPlaySound
ReminderSet
ReminderSoundFile
ReminderTime
RemoteStatus
ReplyRecipientNames
ReplyRecipients
RetentionExpirationDate
RetentionPolicyName
RTFBody
Saved
SaveSentMessageFolder
Sender
SenderEmailAddress
SenderEmailType
SenderName
SendUsingAccount
Sensitivity
Sent
SentOn
SentOnBehalfOfName
Session
Size
Subject
Submitted
TaskCompletedDate
TaskDueDate
TaskStartDate
TaskSubject
To
ToDoTaskOrdinal
UnRead
UserProperties
VotingOptions
VotingResponse
Im using the following code and its been working fine. i have updated to a surface pro and know my macro have stop working.
i think it has some think to do will this line in
Set OutApp = CreateObject("Outlook.Application")
With window 8 i don't think it uses outlook anymore
Has any one else had this problem
Full code below
Private Sub CommandButton21_Click()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "help#hiall.com.au"
.CC = ""
.BCC = ""
.Subject = "Inspection"
.Body = "Inspection n"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
What Outlook version do you have installed on the PC? Did you check out the Trust Center settings in Outlook?
In general, your code is correct, I don't see anything strange... The How to automate Outlook from another program article describes the required steps for automating Outlook.
Be aware, the Click2Run edition of Office 2010 doesn't support automation. Also you may find the You receive run-time error 429 when you automate Office applications article helpful.
I have been trying to write a code but with no avail for the following problem:
I have a set of people who use a database. So everyone puts the time of the day for which they want to use it for e.g.:
Team member Time mail ID
ABC 1 pm - 2 pm ABC#de.com
XYZ 3 pm - 4 pm YXV#de.com
I want that if ABC finishes his work before 2 i.e. at 1:30 pm and if he updates the same on the sheet which is on the server and saves it, the next person due to use the database gets a mail stating that he has that extra 30 mins for the same.
Also, even if ABC finishes on time only i.e. at 2 XYZ should be able to get a reminder of his turn.
Another situation can be if ABC extend his session in the excel, XYZ gets a due indication in mail of the same in order to check and change his time slot.
I don't want everyone on the list to get the e-mail, only the person next in que.
Thanks in advance.
Sats
1) Please add the spreadsheet you are working with so far, as others may be able to provide you with more direction.
2) Here is code snippet to send email via vba in excel to someone; it uses outlook on users desktop to send email.
Sub SendEmail(ByVal strTo as string, ByVal strCC as string, ByVal strSubject As String, ByVal strBody As String, Optional ByVal strHTMLBody As String = "")
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = strTo
.CC = strCC
.subject = strSubject
If strBody <> "" Then
.body = strBody
Else
.HTMLBody = strHTMLBody
End If
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
'.Send ' if you want to send immediately
.Display ' if you want the user to see the email before sending it manually.
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
3) Defining the workflow will require some additional VBA programming which depends on how you have your spreadsheet setup.
Hope this helps.
I am sending email by automating outlook from excel and have managed to bypass the pesky warning message about viruses using sendkeys (with inspector activate just prior to call to sendkeys).
Now I sometimes get a message about allowing access to contacts.
I have the email addresses for the recipients and don't need to access the contacts, but outlook autoresolve kicks in and then a pop up about allowing access to the contacts appears. This doesn't have the 5 second delay, but it still prevents the system being fully automated.
I'm trying to avoid using 3rd party tools like redemption and I was wondering if anyone has found a way to turn autoresolve off.
I've read posts on other sites suggesting turning off autocomplete and automatic name checking, but outlook still attempts to resolve the address when the mail is sent.
Any pointers would be gladly received.
Edit 24/08/13
I have heard that if you outlook 2007 and above and a correctly installed system with a Microsoft approved virus scanner you will not see the message, but I don't have control over the installation of programs on the users machines.
The code that I have tried includes
Function Mailit(byval sMessageTo as String, byval sSamplerCenter as String, byval sFileSpec as String)
Dim olApp As outlook.Application
Dim objMail As Outlook.MailItem
Dim blnOLOpen As Boolean
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
blnOLOpen = True
On Error Goto 0
If olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
blnOLOpen = False
End If
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.To = sMessageTo
.Subject = sSampleCenter
.Attachments.Add sFileSpec
.Send
End With
This causes the warning message about viruses and causes a 5 second wait before a user can choose to send the mail. The sendkeys method I use is the same up to the With objMail but then does the following:
Dim myInspector As Outlook.Inspector
With objMail
.To = MessageTo
.Subject = SampleCenter
.Attachments.Add FileSpec
.Display
End With
Set myInspector = objMail.GetInspector
myInspector.Activate
SendKeys "%s", True
I also have some code for checking that the number of items in the sent folder has increased and waiting/calling the inspector and sendkeys function if it hasn't.
This method doesn't lead to the warning, but often results in a dialog box asking if the user wishes to allow access to their contacts.
In Outlook: Go to Options -> E-Mail and disable the checkbox "Resolve names automatically".