Help required - Bulk Email VBA is not attaching files to email

[sanket_sk]

Hi There,

Greetings!!!

I am stuck in one functionality

Please refer to below code, this code is working fine with Outlook.

Mails are being sent properly however files are not getting attached to these emails, could you please help me correct the code which will send mails with attachments.

Note:- I am not getting any error message, the only issue is emails are getting triggered without attachment.

Code
Dim NewMail As CDO.Message
Set NewMail = New CDO.Message
Dim StartTime As Double
Dim EndTime As Variant
Dim TimeTaken As Variant
Dim i, J, tCount, iValue, iCaption


If Range("B7").Value = "" Then

tCount = 0

ElseIf Range("B8").Value = "" Then

tCount = 1
Else
Range("B7").Select
tCount = Range(Selection, Selection.End(xlDown)).Count
End If

If tCount = 0 Then
MsgBox "At least One Email Should be there to be sent"
Exit Sub
End If


'Enable SSL Authentication
NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'SMTP authentication Enabled

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

'Set the SMTP server and port details

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Set your username and password for your Yahoo Account

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Sanket.katdare@outlook.com"

NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*******"

'Update all configuration fields
NewMail.Configuration.Fields.Update

StartTime = Timer

'Set All Email Properties
i = 7
J = 7
tCount = 1
Unload frmSendEmailOption
DoEvents
Sheet1.Label2.Visible = True
Sheet1.lblProgressBar.Width = 12
Sheet1.lblProgressBar.Caption = 4 & "%"




iValue = (288 / tCount)

On Error Resume Next
While Range("B" & i).Value <> "" Or Range("C" & i).Value <> "" Or Range("D" & i).Value <> ""

With NewMail
.Subject = Range("E" & i).Value
.From = sendUserName
.To = Range("B" & i).Value
.CC = Range("C" & i).Value
.BCC = Range("D" & i).Value
.textbody = Range("F" & i).Value
If Range("H" & i).Value <> "" Then .Attachments.Add Range("H" & i).Value
If Range("I" & i).Value <> "" Then .Attachments.Add Range("I" & i).Value

End With

On Error GoTo err1
'On Error Resume Next

NewMail.Send

Range("B" & i & ":F" & i).Interior.ColorIndex = 2
Range("G" & i).Value = ""
J = J + 1

Sheet1.lblProgressBar.Width = Sheet1.lblProgressBar.Width + iValue
If Int(((Sheet1.lblProgressBar.Width))) < 100 Then
Sheet1.lblProgressBar.Caption = Int(((Sheet1.lblProgressBar.Width))) & "%"
Else
Sheet1.lblProgressBar.Caption = "100%"
End If
DoEvents

i = i + 1

TimeTaken = Timer - StartTime

If TimeTaken >= 50 Then

Set NewMail = Nothing

'Enable SSL Authentication

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'Make SMTP authentication 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 Settings Page of your Gmail Account

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpServer

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = smtpServerPort

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60

'Set your credentials of your Gmail Account

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = sendUserName

NewMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = sendPassword

'Update the configuration fields
NewMail.Configuration.Fields.Update

StartTime = Timer

End If
loop1: Wend


err1: If err.Description Like "*The message could not be sent to the SMTP server*" Then


MsgBox "Connection to SMTP not happening. Check your ID and Password and Try Again"

Sheet1.lblProgressBar.Width = 0
Sheet1.lblProgressBar.Visible = False
Sheet1.Label1.Caption = ""
Sheet1.Label1.Visible = False
Sheet1.Label2.Visible = False
Exit Sub


Else

If err.Number <> 0 Then
Range("B" & i & ":F" & i).Interior.Color = 255
Range("G" & i).Value = err.Description & "(" & err.Number & ")"
i = i + 1
Resume loop1
End If
End If

Sheet1.Label2.Visible = False
Sheet1.lblProgressBar.Visible = False
Sheet1.Label1.Visible = True
Sheet1.Label1.Caption = "#Emails Successfully Sent: " & J - 7 & " #Emails Failed: " & tCount - (J - 7)

End Sub

Sanket

 

[Micron]

If Range("I" & i).Value <> "" Then .Attachments.Add Range("I" & i).Value

End With <<put a break point on this line & run the code. When it stops there, mouse over Range("I"&i) to see what it contains, or in the immediate window type
?Range("I" & i) and press enter. You should see the value if it is not "" or null. If it is, you'll get an empty line added below. If the range contains nothing, you won't add attachments.

I'd also advise you to put code within code tags (use vba button on posting toolbar) and use proper indentation. Not sure if it would prevent your post from having a bunch of urls that people will probably click on or not (those look like CDO SMTP schema references to me). It sure would make your code readable. If you were me, you wouldn't post your email address in a forum either.

 

[sanket_sk]

If Range("I" & i).Value <> "" Then .Attachments.Add Range("I" & i).Value

End With <<put a break point on this line & run the code. When it stops there, mouse over Range("I"&i) to see what it contains, or in the immediate window type
?Range("I" & i) and press enter. You should see the value if it is not "" or null. If it is, you'll get an empty line added below. If the range contains nothing, you won't add attachments.

I'd also advise you to put code within code tags (use vba button on posting toolbar) and use proper indentation. Not sure if it would prevent your post from having a bunch of urls that people will probably click on or not (those look like CDO SMTP schema references to me). It sure would make your code readable. If you were me, you wouldn't post your email address in a forum either.

Hi Micron,

Thanks for quick response!!!

Range ("I" & i) contains file path, i also crosscheck the path by putting in Windows explorer , i mean the path is correct, but still email is getting triggered without attachment, pls guide if any change need in code.

Sanket

 

[Micron]

Can you post an example of what the range holds? I have used CDO to send email before, but it used Outlook. I think you are saying that your code works in Outlook but not with what - Yahoo web mail? In that case I think I don't have the experience you need. Perhaps search "vba cdo email yahoo attachment" ? I did and found this among the results:

How to Send an Email using Excel Macro from Gmail or Yahoo

VBA code to send email. How to send email with HTML body in Excel Macro. Send email with an attachment in Excel VBA. VBA code to send email from gmail. VBA code to send email from yahoo

learnexcelmacro.com

HTH