Sub SendEmailUsingGmail()
Dim Text As String, StrPath As String, StrFile As String
Dim Text2 As String
Dim Text3 As String
Dim i As Integer
Dim j As Integer
Dim NewMail As CDO.Message
i = 1
Do While Cells(i, 1).Value <> ""
Set NewMail = New CDO.Message
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") = "smtp.gmail.com"
NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'Set your credentials of your Gmail Account
NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
NewMail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "****"
'Update the configuration fields
NewMail.Configuration.Fields.Update
With NewMail
StrPath = Cells(i, 2).Value
.Subject = ""
' adds the data in column3 with space as subject
.From = "[email protected]"
Text = Cells(i, 1).Value
StrFile = Dir(StrPath & "*.txt")
'Text2 = Cells(i, 2).Value
.To = Text
.BCC = ""
.TextBody = "WDAdsas"
.AddAttachment StrFile
.Send
End With
i = i + 1
Loop
End Sub
My excel contains email id in the first column, the second column has the address of each attachment:(Excel looks like)
[email protected] E:\Shank E drive\Gon\EBooks\BBB\
shank@gwu. E:\Shank E drive\Gon\EBooks\AAA\
When I debug step by step the I get the txt file in StrFile but the addattachment is not able to read it.
It gives the error specified protocol is unkown.
StrPath= Column2Range
FileType = "*.txt"
strFile = Dir(StrPath & FileType)
If Len(strFile ) = 0 Then
GoTo ExitProc
End If
Do While Len(strFile ) > 0
.AddAttachment StrPath & strFile
strFile = Dir
Loop
ExitProc:
This should work for you. Let me know if you need help making sense of it.
Collected from the Internet
Please contact [email protected] to delete if infringement.
Comments