Excel VBA CDO Email

[quanziee]

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]

any success when changing port 587 to 465?

[quanziee]

nope. it just takes a lot longer than 587 and gives me the same error

[quanziee]

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]

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"