Fire_Chief
Well-known Member
- Joined
- Jun 21, 2003
- Messages
- 697
- Office Version
- 365
- Platform
- Windows
This worked for a long time and now it doesn't work.
I have read every post on here and no help.
PLEASE HELP or this will run me crazy lol
Sub sending_email_CDO()
Dim filepath As String
filepath = Environ$("temp") & "\" & ActiveWorkbook.Name & ".pdf" 'TODO:change filepath for the temp pdf file
On Error GoTo ErrHandler3:
Range("A1:A5").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
filepath, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
'Setting up CDOSYS configuration to send out the email
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.Microsoft.Com/cdo/configuration/smtpusetls") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "My email address"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "my email password"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.comcast.net"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 'Also tried 587
.Update
End With
With iMsg
Set .Configuration = iConf
.From = "Your full gmail address here"
.To = "Your full email here"
JUMP_TO_SUBJECT:
.Subject = "TEST"
.HTMLBody = "HELLO"
.AddAttachment (filepath) 'This is Range "A1:A5" of the worksheet that is being sent
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Kill filepath
MsgBox "YOUR E-MAIL WAS SENT. "
Exit Sub
ErrHandler3:
MsgBox "YOUR E-MAIL DID NOT GO THROUGH. "
Set iMsg = Nothing
Set iConf = Nothing
Kill filepath
Range("A1").Select
End Sub
I have read every post on here and no help.
PLEASE HELP or this will run me crazy lol
Sub sending_email_CDO()
Dim filepath As String
filepath = Environ$("temp") & "\" & ActiveWorkbook.Name & ".pdf" 'TODO:change filepath for the temp pdf file
On Error GoTo ErrHandler3:
Range("A1:A5").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
filepath, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
'Setting up CDOSYS configuration to send out the email
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.Microsoft.Com/cdo/configuration/smtpusetls") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "My email address"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "my email password"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.comcast.net"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 'Also tried 587
.Update
End With
With iMsg
Set .Configuration = iConf
.From = "Your full gmail address here"
.To = "Your full email here"
JUMP_TO_SUBJECT:
.Subject = "TEST"
.HTMLBody = "HELLO"
.AddAttachment (filepath) 'This is Range "A1:A5" of the worksheet that is being sent
.Send
End With
Set iMsg = Nothing
Set iConf = Nothing
Kill filepath
MsgBox "YOUR E-MAIL WAS SENT. "
Exit Sub
ErrHandler3:
MsgBox "YOUR E-MAIL DID NOT GO THROUGH. "
Set iMsg = Nothing
Set iConf = Nothing
Kill filepath
Range("A1").Select
End Sub