My client wants to distribute excel/vba to his clients and the vba will automatically send emails.
Maybe the sender should be some other account, not the outlook account of the person using the vba, because some private stuff might be in the email. Is it really possible?
Another thing is the infamous pop-up warning when automating such tasks. I heard Application.SendKeys doesn't always work when computer's locked.
How is CDO for this task?
On your initial question you can use MailItem.SentOnBehalfOfName with Outlook
On the Security warning the standard two solutions for Outlook are:
1) Use Clickyes
2) Install Outlook Redemption
You don't have to use Outlook to send emails. As you ask, CDO works without using Outlook.
Here's some code to get you started.
Public Sub SendEmail(Subject As String, Body As String, ToPerson as String)
Dim iCfg As Object
Dim iMsg As Object
Set iCfg = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
With iCfg.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "email-account"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Item("http://schemas.microsoft.com/cdo/configuration/sendemailaddress") = "account#domain.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Update
End With
With iMsg
.Configuration = iCfg
.Subject = Subject
.TextBody = Body
.To = ToPerson
.Send
End With
Set iMsg = Nothing
Set iCfg = Nothing
End Sub
Related
I need to periodically send e-mails and I used the following code for years:
Function SSLSendMail(sTO As String, sFROM As String, sSubject As String, sText As String, sServer As String, _
sUser As String, sPassword As String, Optional sAttach As String, Optional sCC As String, Optional sBCC As String) As Boolean
Dim ObjSendMail As Object
Set ObjSendMail = CreateObject("CDO.Message")
Dim iConf As Object
Set iConf = CreateObject("CDO.Configuration")
With iConf.Fields 'Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort ' 2
.Item(cdoSMTPAuthenticate) = cdoBasic ' 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True ' If use SSL set to True, if not, set to False
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item(cdoSendUserName) = sUser
.Item(cdoSendPassword) = sPassword
.Item(cdoSMTPServer) = sServer
.Item(cdoSMTPConnectionTimeout) = 10
.Update
End With
Set ObjSendMail.Configuration = iConf
With ObjSendMail
.To = sTO
.Subject = sSubject
.from = sFROM
.TextBody = sText
If sAttach > "" Then
.AddAttachment sAttach
End If
If sCC > "" Then
.cc = sCC
End If
If sBCC > "" Then
.BCC = sBCC
End If
On Local Error GoTo invalidTo
.Send
On Local Error GoTo 0
End With
Set ObjSendMail = Nothing
Set iConf = Nothing
SSLSendMail = True
Exit Function
invalidTo:
Debug.Print "Error on " & sTO & ": " & Err.description
Err.Clear
SSLSendMail = False
End Function
In the last days, I get error 0x80040217 and the mail is not sent. After some investigation, I found that Google changed the authentication method from Basic to OAuth2 or, at least, that is what I have to change in my Thunderbird client in order to be able to send mails.
I have seen an answer to a similar question suggesting to use Outlook object, but that is not applicable for a series of reasons: I don't have any outlook user configured (and I don't want to!), the "sender" seems not dynamically specified, etc.
I guess I have to change .Item(cdoSMTPAuthenticate) = cdoBasic to something else, but I cannot find anything related to OAuth2.
After days and days of unsuccessfully testing changes in that code, I finally realized the problem was in the SMTP server only. I had to access my Google configuration page, ask for a second level security for the specific machine on which the Excel VBA is running and I got an encrypted password, based on my regular password, I guess. Using that password, the above code works fine, as before. Thanks Google for making our life more difficult!
When I send an assignment to students, I create an individualized file I want each student to work on. I generate the files using VBA and Excel.
I put Outlook in "Work Offline" mode so I can make sure the e-mails have the correct attachments before I put Outlook back online. I usually then hit the "send/receive all folders" button so they'll go out immediately while I'm watching.
This works at work where I have Outlook configured with just my work e-mail.
On Outlook at home (the installed app on a Windows 10 machine), I have two accounts configured.
Account #1 is a personal e-mail from a personal domain.
Account #2 is my e-mail account for work.
I want to generate e-mails like I do at work, and for them to go in the outbucket of my work account. I would then send them from there.
However, they go into the outbucket of my personal account. I don't want students to get an e-mail from an unrecognized sender. Nor do I want them replying to those e-mails.
The code to create e-mails:
Sub makemail()
Dim strLocation As String
Dim OutApp As Object
Dim OutMail As Object
Dim OutAccount As Object
Range("a1").Activate
eaddy = ActiveCell.Offset(0, 4).Value 'student's e-mail address in a worksheet
IndivFile = ActiveCell.Offset(0, 8).Value 'this is an identifier for the student's individual file
LastName = ActiveCell.Offset(0, 1).Value ' student's last name
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set OutAccount = OutApp.Session.Accounts.Item(1)
On Error Resume Next
With OutMail
.To = eaddy
.CC = ""
.BCC = ""
.Subject = LastName & " (text that describes the assignment)"
.Body = "(body of message)"
strLocation = "(location of the individual attachments" & IndivFile & ".xlsx"
.Attachments.Add (strLocation)
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Set OutAccount = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
ActiveCell.Offset(1, 0).Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Loop
End Sub
It dumps the generated e-mails into the outbucket of account #1: my personal account.
I tried replacing .Send with .SendUsingAccount = OutApp.Session.Accounts.Item(2)
Putting anything in the parentheses (including a 0 or 1) will mean I don't see the output in either outbucket. (No idea if the e-mails even generated. they're probably sitting in some directory I haven't looked in.)
So, I just generated all the e-mails and they showed up in my personal account's outbucket.
I selected them all and dropped them into the outbucket of my work account.
I clicked the "send/receive" and they won't go anywhere.
If I open each e-mail individually and click the "send" button in the e-mail, they go. I see them in my sent folder.
I don't know that much about Outlook. I wonder if this is some sort of mismatched certificate problem on the e-mails? But if that were the case, why don't they go in bulk, but will go if sent individually with the e-mail open?
I just tested. if the e-mails are marked read or unread, it makes no difference.
I did set my work-email as the primary in Outlook (File > Account Settings > Designate one account as the primary one.
My questions:
Is there a way, code-wise, to put this in the second account's outbucket (work)?
Keep in mind that .SendUsingAccount = OutApp.Session.Accounts.Item(2) did not work.
If I can't do that, is there a way to change my e-mail accounts so the work one is #1?
Other than deleting and re-installing in a specific order?
I did go in and make the work-email my primary e-mail.
Why won't they send in one outbucket (because they were dragged and dropped from another outbucket), but will send if you open them individually?
It seems you just need to set/change the default account in Outlook.
See How To Set An Email Account As The Default Account In Outlook? for more information.
Also, you can use the SendUsingAccount property of Outlook items which sets an Account object that represents the account under which the MailItem is to be sent. The SendUsingAccount property can be used to specify the account that should be used to send the MailItem when the Send method is called.
Sub SendEmailFromAccount(ByVal application As Outlook.Application, _
ByVal subject As String, ByVal body As String, ByVal recipients As String, ByVal smtpAddress As String)
' Create a new MailItem and set the To, Subject and Body properties.
Dim newMail As Outlook.MailItem = DirectCast(application.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)
newMail.To = recipients
newMail.Subject = subject
newMail.Body = body
' Retrieve the account that has the specific SMTP address.
Dim account As Outlook.Account = GetAccountForEmailAddress(application, smtpAddress)
' Use this account to send the email.
newMail.SendUsingAccount = account
newMail.Send()
End Sub
Function GetAccountForEmailAddress(ByVal application As Outlook.Application, ByVal smtpAddress As String) As Outlook.Account
' Loop over the Accounts collection of the current Outlook session.
Dim accounts As Outlook.Accounts = application.Session.Accounts
Dim account As Outlook.Account
For Each account In accounts
' When the email address matches, return the account.
If account.SmtpAddress = smtpAddress Then
Return account
End If
Next
End Function
Okay, found it out. Part of it depended on going to Tools > References and then making sure I've got Microsoft Outlook 16.0 Object Library is selected. Granted, you can do this without early bindings, but it seemed to help.
Here is the code I eventually came up with:
Sub makemail()
Range("a1").Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Dim objOutlook As Object
Dim objMail As Object
Worksheets("Rollcall").Activate
Set objOutlook = CreateObject("Outlook.Application")
Dim oAccount As Outlook.Account
Set oAccount = Outlook.Application.Session.Accounts(1)
Debug.Print oAccount
If oAccount = "outlook account you want to use" Then
Debug.Print ("condition true")
'Main Logic ============================================
Do Until ActiveCell.Value = ""
Set objMail = objOutlook.CreateItem(0)
On Error Resume Next
With objMail
.To = eaddy
'.CC = ""
'.BCC = ""
.Subject = (your subject)
.Body = "your outgoing message"
strLocation = "(location of attachment"
.Attachments.Add (strLocation)
Set .SendUsingAccount = oAccount
.Send
End With
Set objMail = Nothing
ActiveCell.Offset(1, 0).Activate
eaddy = ActiveCell.Offset(0, 4).Value
IndivFile = ActiveCell.Offset(0, 8).Value
LastName = ActiveCell.Offset(0, 1).Value
Loop
Set objOutlook = Nothing
End If
End Sub
I need to send an email from an SMTP server so it is from "Automated Notification <NoReplyEmail#agit.com>".
I tried browsing ways to send emails with that From address. Apparently, SMTP is a way. How do I connect it using Outlook?
I did this before using CDO. Is there any way to amend it to Outlook?
Dim iCfg As CDO.Configuration
Set iCfg = New CDO.Configuration
With iCfg
.Fields(cdoSMTPServer) = "sgp.smtp.agit.com"
.Fields(cdoSMTPServerPort) = 25
.Fields(cdoSendUsingMethod) = cdoSendUsingPort
.Fields(cdoSMTPConnectionTimeout) = 200
.Fields.Update
End With
Set .Configuration = iCfg
Is there any other way I could get "Automated Notification <NoReplyEmail#agit.com>" as my From address?
I have not seen a code where you add the From parameter and how you're actually sending the emial.
But based on my experience with CDO you will need a CDO.Message object.
So try this:
Dim cdoMsg AS CDO.Message
Set cdoMsg = CreateObject("CDO.Message")
With cdoMsg
Set .Configuration = iCfg '// from the code snipped in the question above
.From = "NoReplyEmail#agit.com" '// you only need to set this parameter
.To = "someone#someweb.com"
.Subject = "Your Subject"
.TextBody = "Sample Text"
.Send
End With
Take note that you cannot put the alias of the SMTP unless it is set up at your server. So even if you set the From parameter like this:
.From = """Automated Notification"" <NoReplyEmail#agit.com>"
alias will not appear upon receiving mail.
I'm trying to send an automated mail based on whether a checkbox is checked.
The code works perfectly without the If function. But with it, I get:
Error 438: Object doesn't support this property or method.
I'd rather keep the If function so the mail only gets sent by checking the box. Without the If function, the mail gets sent when unchecking as well.
Sub Checkbox1_Click()
Dim OutLookApp As Object
Dim Mail As Object
Dim subject_ As String
Dim body_ As String
subject_ = "Something"
body_ = "Something else"
If Sheets("Sheet1").CheckBox1.Value = True Then
Set OutLookApp = CreateObject("Outlook.Application")
Set Mail = OutLookApp.CreateItem(0)
Application.DisplayAlerts = False
With Mail
.Subject = subject_
.Body = body_
.To = "email"
.CC = "otheremail"
.Importance = 2
.Send
End With
Application.DisplayAlerts = True
End If
End Sub
You can try using the ActiveSheet.OLEObjects ("CheckBox1"). Object.Value> 0 as condition to check it.
For more information, please see the following links:
Using Control Names with the Shapes and OLEObjects Collections
Checking if a worksheet-based checkbox is checked
We send out a lot of spreadsheets around the organisation, in order to automate this as much as possible we wrote some code to send this automatically and allow us to still put body text in.
This particular Script picks information up from our Finance System (SAP) dumps it into Excel and emails it to the user, it loops through a number times downloading and emailing different data each time.
This works fine on our old windows 7 (Office 2010) machines but some of us have been given new Windows 10 (Office 365) machines to pilot.
The code runs without any error messages but when it gets to .Send it jumps straight to End Sub and does not send the email.
I have tried EmailItem.Display and you can see the email being populated and then just stays visible on the desktop as it loops through the rest of the emails.
Any ideas on how to get round this? I could use the application.send function but I like to have the ability to add custom text into the email body.
Thanks :)
Sub EmailData()
Dim OL As Object
Dim EmailItem As Object
Dim y As Long
Dim TempChar As String
Dim Bodytext As String
Dim Flds As Variant
Dim EmailText As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Email Download to nursery
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.Createitem(OLMailItem)
'Check File Name is correct
Filename = Range("A1") & ".xls"
For y = 1 To Len(Filename)
TempChar = Mid(Filename, y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|"
Case Else
SaveName = SaveName & TempChar
End Select
Next y
ActiveSheet.Cells.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
With ActiveWindow
.DisplayGridlines = False
.DisplayZeros = False
End With
Range("A1:S38").Select
Selection.Locked = True
Selection.FormulaHidden = False
Set EmailText = ActiveSheet.Range("AB1:AB5").SpecialCells(xlCellTypeVisible)
ActiveSheet.Protect ("keepsafe")
ActiveWorkbook.SaveAs Networkpath & "\" & SaveName, , "", , True
ActiveWorkbook.ChangeFileAccess xlReadOnly
EmailItem.display
'On Error Resume Next
With EmailItem
.To = "Daston#blahblah.uk"
'.To = Range("AA1")
.CC = ""
.BCC = ""
.Subject = Filename
.HTMLBody = RangetoHTML(EmailText)
.Attachments.Add ActiveWorkbook.FullName
.send
End With
Application.Wait (Now + TimeValue("0:00:02"))
Kill Networkpath & "\" & SaveName
ActiveWorkbook.Close False
Set OL = Nothing
Set EmailItem = Nothing
End Sub
This describes how, in certain situations, you may "make the object model fully functional".
NameSpace.Logon Method (Outlook)
"first, instantiate the Outlook Application object, then reference a default folder such as the Inbox. This has the side effect of initializing MAPI to use the default profile and to make the object model fully functional."
Sub InitializeMAPI ()
' Start Outlook.
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
' Get a session object.
Dim olNs As Outlook.NameSpace
Set olNs = olApp.GetNamespace("MAPI")
' Create an instance of the Inbox folder.
' If Outlook is not already running, this has the side
' effect of initializing MAPI.
Dim mailFolder As Outlook.Folder
Set mailFolder = olNs.GetDefaultFolder(olFolderInbox)
' Continue to use the object model to automate Outlook.
End Sub
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.
HKCU\Software\Policies\Microsoft\office\16.0\outlook\security\
promptoomaddressbookaccess
promptoomaddressinformationaccess
https://support.microsoft.com/en-za/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo
The most probable cause is Outlook Security.
You can find the security configurations in HKCU\Software\Policies\Microsoft\office\16.0\outlook\security
(change 16.0 to your office version)
Change promptoomsend 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