PDA

View Full Version : Excel VBA CDO Email



quanziee
07-26-2018, 05:22 AM
Hi I want to create a macro that can send emails without having to use the outlook application. I have tried using CDO but when I run my macro I get an error saying: "Run-time error, The server rejected the sender address. The server response was: 530 5.7.57 SMTP; Client was not authenticated to send anonymous mail during MAIL FROM ...."

Here is my code:


Sub CDO_Mail_Small_Text() Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
Dim Flds As Variant


Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")


iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-mail.outlook.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "xxxx@outlook.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "xxxxx"

.Update
End With


strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"


With iMsg
Set .Configuration = iConf
.To = "xxxx@gmail.com"
.CC = ""
.BCC = ""
.From = " <xxxx@outlook.com>"
.Subject = "Important message"
.TextBody = strbody
.Send
End With


Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
End Sub

I've already added the username and password so I don't see what the error is talking about? Also when I add the following lines of code:

.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

It will give me a new error, saying "The transport failed to connect to the server." However when I try changing the smtp serverport to 25 or 465, the macro will get stuck at

.Send and not complete the macro.

mancubus
07-26-2018, 06:06 AM
any success when changing port 587 to 465?

quanziee
07-26-2018, 09:38 AM
nope. it just takes a lot longer than 587 and gives me the same error

quanziee
07-26-2018, 09:43 AM
actually, i tried being patient this time and tried using 25. it takes a minute or two but it works. not really ideal for automated emails though

quanziee
07-26-2018, 11:31 AM
however i am having difficulty with trying to attach a sheet as a pdf to the email. Here is my code for the attachment:

Dim PdfFile As String, Title As String
Dim printRange As Range
Dim i As Long

Title = Sheets("Hotel Booking").Range("AF17")
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = PdfFile & "_" & Sheets("Hotel Booking").Name & ".pdf"

Set printRange = Range(Sheets("Hotel Booking").PageSetup.PrintArea)




With Sheets("Hotel Booking")
printRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With

With iMsg
.AddAttachment PdfFile
End with

Kill PdfFile


It will attach a blank html attachment labelled "noname.hmtl" and it will give me an error on this line

Kill PDfFile
saying that "PdfFile is not found"