E-mail code doesn't work

Fire_Chief

Well-known Member
Joined
Jun 21, 2003
Messages
690
Office Version
  1. 365
Platform
  1. Windows
I have tried for 3 days to get this to work.
PLEASE HELP ME



Sub SendEmailUsingYahoo()

On Error GoTo Err

Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String

Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

' load all default configurations
mailConfig.Load -1

Set fields = mailConfig.fields

'Set All Email Properties

With NewMail
.Subject = "Test Mail from LearnExcelMacro"
.From = "ncaatest@yahoo.co.in"
.To = "D1C@comcast.net.com;D1C@comcast.net"
.CC = ""
.BCC = ""
.TextBody = "TEST"
End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

With fields
'Enable SSL Authentication
.Item(msConfigURL & "/smtpusessl") = True

'Make SMTP authentication Enabled=true (1)
.Item(msConfigURL & "/smtpauthenticate") = 1

'Set the SMTP server and port Details
'To get these details you can get on Settings Page of your yahoo Account
.Item(msConfigURL & "/smtpserver") = "smtp.mail.yahoo.com"
.Item(msConfigURL & "/smtpserverport") = 465
.Item(msConfigURL & "/sendusing") = 2

'Set your credentials of your yahoo Account
.Item(msConfigURL & "/sendusername") = "ncaatest@yahoo.com.in"
.Item(msConfigURL & "/sendpassword") = "mypassword"

'Update the configuration fields
.Update

End With
NewMail.Configuration = mailConfig
NewMail.Send
MsgBox ("Mail has been Sent")

Exit_Err:

Set NewMail = Nothing
Set mailConfig = Nothing
End

Err:
Select Case Err.NUMBER

Case -2147220973 'Could be because of Internet Connection
MsgBox " Could be no Internet Connection !! -- " & Err.Description

Case -2147220975 'Incorrect credentials User ID or password
MsgBox "Incorrect Credentials !! -- " & Err.Description

Case Else 'Rest other errors
MsgBox "Error occured while sending the email !! -- " & Err.Description
End Select

Resume Exit_Err

End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
I just want to be able to send a section of a page as a pdf through code.
I have a NCAA pool that I send to several guys the spreads and the results.

Like Range("A1:E35").select
Then send that to many people.

I can handle the people it goes to and everything else. I just can't get it to work with Yahoo. It works great with comcast.
 
Upvote 0
.
Paste in regular module :

Code:
Option Explicit
Sub CopyRows()
Dim i As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Sheet1")
    ws1.Range("L47:U50").Copy  '.................................<--- edit range here
    Mail_Selection_Range_Outlook_Body
End Sub


Sub Mail_Selection_Range_Outlook_Body()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim lEndRow
Dim Value As String
Set rng = Nothing
' Only send the visible cells in the selection.
Set rng = Sheets("Sheet1").Range("L47:U50") '...................<--- edit range here
If rng Is Nothing Then
    MsgBox "An unknown error has occurred. "
    Exit Sub
End If
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
    .to = "Your email address here in quotes"
    .CC = ""
    .BCC = ""
    .Subject = "Change in Plans See Below"


    .HTMLBody = "<p>Text above Excel cells" & "<br><br>" & _
                RangetoHTML(rng) & "<br><br>" & _
                "Text below Excel cells.</p>"
    
    ' In place of the following statement, you can use ".Display" to
    ' display the e-mail message.
    '.Send
    .Display
End With
On Error GoTo 0
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function RangetoHTML(rng As Range)
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook
    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    'Close TempWB
    TempWB.Close savechanges:=False
    'Delete the htm file we used in this function
    Kill TempFile
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
 
Upvote 0
I don't have to put in the smtp name or my e-mail address or my password.

I do want them to know where it came from. Some do not have excel so it has to be a PDF.


If above is true. Can I use this to send from Comcast and gmail also?
That would be great.
 
Last edited:
Upvote 0
.
You will need to setup OUTLOOK on your machine linked to your email address. The macro utilizes OUTLOOK to send the email.
 
Upvote 0
That's what I thought. Some of them do not use outlook. That's why I send it as a PDF. They can all open it that way.
 
Upvote 0
.
They don't need to have OUTLOOK.

I have my OUTLOOK configured for my YAHOO email account. The macro creates the email ... I can embed anything into the body of the email or attach
anything I want to the email ... and it sends the email.

I can receive the email on my YAHOO account and it looks like any other email I would receive from anyone, anywhere using any email client they want.
If I send the email to my son who uses GMAIL, he receives the email just like any other email he might receive.

Here is a pic of what the email looks like. The sheet in the back is the original excel worksheet with a range of data. The foreground image is the created email
prior to sending : https://www.amazon.com/clouddrive/share/1C6cA0tnYyhIL9uxKCV9eA3UeRoEMU59MzDGsAjkTGG
 
Upvote 0
Hey Logit. I think that works. I am going to try it with comcast and gmail next but..
My brain is fried for today. Got to quit for a while.

Would you mind if I ask you something IF I get stuck again.

AND Thank you
 
Upvote 0

Forum statistics

Threads
1,213,495
Messages
6,113,992
Members
448,538
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top