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.
Related
I am trying to send outlook mail using VBA . Every time I run my macro a pop-up comes to me of TITUS stating as select data risk classification. My question is if there any way I can bypass it or select it automatically and send an email.
I have the attempted code snippets to achieve it from multiple sources from internet below.
Sub test()
Dim AOMSOutlook As Object
Dim AOMailMsg As Object
Set AOMSOutlook = CreateObject("Outlook.Application")
Dim objUserProperty As Object
Set AOMailMsg = AOMSOutlook.CreateItem(0)
Set objUserProperty = AOMailMsg.UserProperties.Add("TITUSAutomatedClassification", 1)
objUserProperty.Value = "TLPropertyRoot=ABCDE;Classification=Internal;Registered to:My Companies;"
With AOMailMsg
.To = "v-fexue#outlook.com"
.Subject = "New Report"
.HTMLBody = "Hi"
.Save
.Send
End With
Set AOMailMsg = Nothing
Set objUserProperty = Nothing
Set AOMSOutlook = Nothing
Set lOMailMsg = Nothing
Set objUserProperty = Nothing
Set lOMSOutlook = Nothing
End Sub
Also please clear if objUserProperty.Value = "TLPropertyRoot=ABCDE;Classification=Internal;Registered to:My Companies; Registered to: (has to be actual company name)
Thanks in advance.
You may contact Titus developers for the actual format of the string that needs to be set to avoid any popups from their add-in in Outlook. Also you may check out the sent items for properties set by the add-in, use any low-level property explorer tool such as MFCMAPI or OutlookSpy for that.
I found several variations to send email via Gmail in VBA and watched a YouTube demo using the sub below.
I tried smtpserverport 25 and 465.
I tried smtpserver smtp.gmail.com and smtp.office365.com.
I have the Microsoft CDO Reference selected.
I verified the Gmail password and get no error messages, no compile errors.
I call the sub from the main routine above via send_email_via_gmail. I added a Msgbox just past the send statement to make sure the sub is called and it does reach it but I never get the emails. I have O365.
Sub send_email_via_gmail()
Dim myMail As CDO.Message
Set myMail = New CDO.Message
myMail.Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
myMail.Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
myMail.Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
myMail.Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
myMail.Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxxxxx#gmail.com"
myMail.Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxxxx"
myMail.Configuration.fields.Update
With myMail
.Subject = "Test email from Stock App"
.From = "xxxxxxx#gmail.com"
.To = "xxxxxxx#comcast.net"
.TextBody = "Test email from Me to Me"
End With
On Error Resume Next
myMail.Send
Set myMail = Nothing
End Sub
When I remove the On Error statement I do get a run-time error
The message could not be sent to the SMPT server. The transport error code was 0x80040217. The server response was not available.
Don't turn off 2-step verification ... create a custom gmail password for this app.
https://support.google.com/accounts/answer/185833?hl=en
I want to save the email in my local folder, and I saw this link
https://www.mrexcel.com/forum/excel-questions/361751-vba-saving-email-only-after-send-pushed.html
which basically use the class module to save the email after sending it out.
However the problem is, the email saved is the preview email (email that is being displayed before you send the email) instead of sent email (email in which you cannot edit anything anymore)
Dim cls_OL As New clsOutlook
Public objMail_SentMsg As Object
Public Emailpath As String
Sub SendEmail()
Dim OutMail As Object
Set cls_OL.obj_OL = CreateObject("Outlook.Application")
cls_OL.obj_OL.Session.Logon
Set OutMail = cls_OL.obj_OL.CreateItem(0)
Set objMail_SentMsg = OutMail
Emailpath = "V:\test\emailname.msg"
With OutMail
On Error Resume Next
'Assume this all strings variables are fine
.HTMLBody = strmsgContent1 & strmsgContent2
.to = ToEmail
.CC = CC
.BCC = BCC
.Subject = Subject
.Display
End With
Set OutMail = Nothing
End Sub
Option Explicit
Public WithEvents obj_OL As Outlook.Application
Private Sub obj_OL_ItemSend(ByVal Item As Object, Cancel As Boolean)
objMail_SentMsg.SaveAs Emailpath
Set obj_OL = Nothing
End Sub
It saved the email succesfully but as mentioned, only saved the preview/display email not the sent email.
Thank you so much for your help.
Instead of ItemSend monitor the SentItems folder with ItemAdd.
Do not save objMail_SentMsg, save the item identified by ItemAdd as being added to the folder.
If necessary to differentiate mail not to be saved, set up some unique characteristic in the mail when it is created.
I have been trying to figure this out, but I cannot. I'm working on a VBA project for a manufacturing setting, where forklift drivers need be able to directly email updated lists of material movements to clerks who document them in a new database system.
The idea is that there is a set of hard-coded email addresses in a Module and one click sends the spreadsheet directly to the email after the driver selects the clerk on duty in the particular shift.
The utility for drivers to pick the clerk on the shift is easy enough, the following rolls through 5 different clerks, scattered on various shifts, but there is little point in repeating the code:
Private Sub cboClerk_Change()
With UserForm1.cboClerk
If .ListIndex = 0 Then 'listindex goes from 0 to 4
UserForm1.lblEmail = "fname.lname#company.com"
ThisWorkbook.Sheets(1).Range("C1") = UserForm1.lblEmail
ThisWorkbook.Sheets(1).Range("A1") = "Clerk on duty: First, Last"
End If
end with
The next part is causing me issues. There are a number of examples for accessing gmail from VBA that I've tried adapting, and this was the most promising solution that I was able to locate, and of which I claim no authorship whatsoever:
Sub ActivateGmail()
Dim newMail As CDO.Message
Set newMail = New CDO.Message
'enable SSL authentication
newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
'make SMTP authenticaion Enabled = true (1)
newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'set the SMTP server and port details
'to get these details you can get on the settings page of your Gmail account
newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 2
newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 587
'set your credentials of your Gmail account
newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "firstandlast#company.com"
newMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "mypassword"
'update the configuration fields
newMail.Configuration.Fields.Update
'set all email properties
With newMail
.Subject = "Test mail"
.From = "firstandlast#company.com"
.To = "firstandlast#company.com"
.TextBody = "I gots it!"
End With
newMail.Send
MsgBox ("Mail has been sent")
'set the newMail variable to nothing
Set newMail = Nothing
End Sub
There is a corporate portal with a global ID and password that includes access to gmail, which I believe prevents me from referring to gmail directly with the above solution. Attempting to login from gmail.com redirects to the corporate login page, which has its own login credentials. I've temporarily resorted to the following:
Sub try6()
ThisWorkbook.FollowHyperlink Address:="http://www.gmail.com", NewWindow:=True
End Sub
...which works should the driver be luckily already logged into gmail, but it would still necessitate the manual labour of sending an email. Because of lacklustre wifi at the factory I work in, logins time out and this is not a sufficient solution. As such, I am wondering how to incorporate a corporate login portal as a part of a VBA gmail solution?
Thank you in advance.
Unbelievable. I think I figured it out.
First, credit to the author on this page for the code that looks similar to the first post: http://www.codekabinett.com/rdumps.php?Lang=2&targetDoc=send-email-access-vba-cdo
To wit:
Public Sub sendmail()
Dim mail As CDO.Message
Dim config As CDO.Configuration
Set mail = CreateObject("CDO.message")
Set config = CreateObject("Cdo.configuration")
config.Fields(cdoSendUsingMethod).Value = cdoSendUsingPort
config.Fields(cdoSMTPServer).Value = "aspmx.l.google.com"
config.Fields(cdoSMTPServerPort).Value = 25 '25
config.Fields(cdoSMTPAuthenticate).Value = cdoBasic 'cdoNTLM 'cdoBasic 'cdoNTLM
config.Fields(cdoSendUserName).Value = "fname.lname#company.com" 'domain is not gmail
config.Fields(cdoSendPassword).Value = "mypassword"
config.Fields.Update
Set mail.Configuration = config
With mail
.To = "fname.lname#company.com"
.From = "fname.lname#company.com"
.Subject = "Hello"
.TextBody = "Plain email with CDO"
'.addattachment "Path"
.Send
End With
Set config = Nothing
Set mail = Nothing
End Sub
What cracked the problem was replacing smtp.gmail.com with aspmx.l.google.com. What it does is it bypasses the corporate login portal entirely and can send an email from the driver's account without him even needing to be logged into it. That's even better than I was hoping for.
Authentication must not be 465 or 587, which are Google's outgoing ports, because the Config.fields.updateline will throw an error. It must be either cdoBasic or cdoNTLM, both of which work in sending an email. I'm not aware of any additional options than these, currently.
SMTPServerPort should (must?) be 25.
Hopefully this works for anyone else facing similar issues.
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