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".
Related
So i have developed a tool wherein there are set of email templates that can be chosen for reply. I am trying to work the tool to reply to an active email or selected email.
The tool works when you have selected an email in outlook. The problem is it won't work when for example you have opened a saved email in a shared folder, instead of replying to that opened email (saved from the folder) the tool actually open the selected email in outlook instead.
Dim OutlookApp as object
Dim outlookmail as object
Set OutlookApp as GetObject(, "Outlook.application")
Set outlookmail = OutlookApp.ActiveExplorer.Selection.Item(1).ReplyAll
If checkbox1.value = true then
.bodyformat = olFormatHTML
.display
.HtmlBody = 'mssg
End if
End sub
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 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
I have an excel spreadsheet with some VBA that will send a marketing email to everyone with an email address in a spreadsheet.
When I send it through my main account it works absolutely perfectly but when I try to send it through our 'marketing#' email account, it only sends back to that account.
The emails send from my account (correctly) and appear in my sent items and when they are received in the marketing# account, the reply address is marketing# so everything appears to be working. It is just not sending to the recipient.
I have permission to SendAs in Exchange and this works (if I try a different address I get an access denied error message) but cannot work out why this isn't working for me at all.
This is my code:
Private Sub StackOverflow()
Dim OlApp As Outlook.Application
Dim olMail As Outlook.MailItem
Set OlApp = New Outlook.Application
Set olMail = OlApp.CreateItem(olMailItem)
With olMail
.SentOnBehalfOfName = """Marketing"" <marketing#>"
.To = "Recipient"
.Subject = "Test"
.Body = "Test"
.Display
End With
Set olMail = Nothing
Set OlApp = Nothing
End Sub
What changes I need to make to this code to get it to send to the recipient and not back to the account I'm sending from?
This has now been solved and it's nothing to do with Excel or Outlook.
It seems that somehow, a rule was placed on the server that re-routed anything sent from this account to the account instead. Now this rule has been removed, the code works perfectly.
I am trying to write a simple program to automatically send emails from a list in excel, and it works, but outlook keeps opening pop ups asking for permission. How do you get outlook to not ask for permission anymore and just do what excel tells it without the pop ups
Heres the code I have so far:
Sub SendMessage()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim recemail
Dim i As Integer
i = 1
recemail = Sheet1.Cells(i, 1)
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(recemail)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "TEST!"
.Body = "DOES THIS WORK!?"
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
i = i + 1
End Sub
This is a manual operation that you need to do :
Run Outlook as Administrator
Go to Tools (Outlook 2007) or File, Options (Outlook 2010 and up)
Go to Trust Center
Change the Programmatic Access setting to : Never warn me about suspicious activity
You can now close Outlook and from now on, you'll have access every time without the popup!
BTW, to avoid opening a new instance of Outlook (if there is already one), use this :
'Create or Get the Outlook session.
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set objOutlook = CreateObject("Outlook.Application")
On Error GoTo 0