Email from Excel

[Nyge2k3]

Hi

I have a list of email addresses in column B of a worksheet called "email contacts", B1 is the heading, so the addresses start in B2.

I'm looking for a macro which opens a new email in Outlook and puts the above list into the "To" section.

I then want to be able to put "This Text" in the subject line and "Hi All" (New Paragraph) "Please find attached......." (New Paragraph) "Regards" in the main body.

Can anyone help?

Thanks

 

[dermie_72]

See if this works for you.

Sub Nyge2k3()
Dim OutApp As Object
Dim OutMail As Object
Dim wbTemp As Workbook
Dim strFileName As String
Dim Sendrng As Range
Dim Starttime As Double
Dim Secondselapsed As Double
Dim tolist As String
Dim I As Integer

Starttime = Timer
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.ActiveSheet.Copy
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
tolist = Range("B2").Value
strFileName = ""   'location and name of the file you want to attach.
For I = 3 To 5   'change 5 to the last cell with an email address
    tolist = tolist & ";" & Range("B" & I).Value
Next I
With OutMail
    .To = tolist     'change this email address to the person you want to receive the form
    .CC = ""                            'include anyone you want CC'd
    .BCC = ""                           'include anyone you want BCC'd
    .Subject = "This Text"             'change the subject line to what is appropriate
    .Body = "Hi All" & vbCrLf & "Please find attached......" & vbCrLf & vbCrLf & "Regards, "                         'this is what goes into the body of the email.
    '.Attachments.Add strFileName        'this attaches the file to the email
    .Display                               'use .Send if you want them to send the mail manually
End With
Set wbTemp = Nothing
Set OutApp = Nothing
Set OutMail = Nothing
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Secondselapsed = Round(Timer - Starttime, 2)
MsgBox "This code ran successfully in " & Secondselapsed & " seconds", vbInformation 'can be removed if you don't want to know how long it takes to run.
End Sub

 

[Nyge2k3]

Many thanks.

I'll give this a try when I'm back from my holiday.