Solved

Email From Outlook using Email Addresses in Excel via Macro

Posted on 2013-01-24
2
499 Views
Last Modified: 2013-01-24
I would like to take a list of email addresses from Excel and place them in the "To" field of an Outlook email. In column A of the attached file is a list of email addresses that I would like to place into the "To" field of an Outlook email. One email with all addresses.

I would like to do this via a macro.

Any help would be much appreciated.
testfile.xlsx
0
Comment
Question by:woodsboro_kid
2 Comments
 
LVL 12

Accepted Solution

by:
telyni19 earned 350 total points
ID: 38815496
Here is a macro that checks to see if Outlook is running, creates a new email message, and adds as many email addresses as are present in column A of the current sheet. Attached is your file with the code included. If you click the Macros button on the View tab, you can run it using the EmailMsg routine. (Note that I had to save the file as .xlsm in order to save it with code included.)

If you want to have the macro add a subject or message body as well, you could add these lines after the while loop or really anywhere in the With statement block:

    .Subject = strSubject
    .Body = strMessage

(And either define the strSubject and strMessage variables and fill their values before that, or replace them with string literals.)

Public Sub EmailMsg()
Dim olApp As Object
Dim olNS As Object
Dim olMsg As Object
Dim olRecipList As Object
Dim msgresult As Integer
Dim strEmailSendTo As String
Dim i As Integer


On Error GoTo ErrSkip

    'Test to see if Outlook is running.
    On Error Resume Next    'Defer error trapping.
    Do
        Err.Clear
        Set olApp = GetObject(, "Outlook.Application")
        If Err.Number <> 0 Then msgresult = MsgBox("Error connecting to Outlook: " & Err.Description & _
            " (" & Err.Number & "). Please open Outlook and then retry generating the email notification.", vbRetryCancel)
    Loop While (Err.Number <> 0) And msgresult = vbRetry
    If Err.Number <> 0 Then GoTo ExitErr
    Err.Clear    'Clear Err object in case error occurred.

On Error GoTo ErrSkip

Set olNS = olApp.GetNamespace("MAPI")
Set olMsg = olApp.CreateItem(0)  'olMailItem = 0

With olMsg
    'Add the To recipient(s) to the message.
    i = 1
    strEmailSendTo = ActiveSheet.Range("A" & i).Value
    While Len(strEmailSendTo) > 0
        .Recipients.Add(strEmailSendTo).Type = 1 'olTo = 1
        i = i + 1
        strEmailSendTo = ActiveSheet.Range("A" & i).Value
    Wend

    'Resolve each Recipient's name.
    For Each olRecipList In .Recipients
      olRecipList.Resolve
    Next
    .Display
End With

ExitErr:
Exit Sub

ErrSkip:
    MsgBox "Error in EmailMsg function." & vbCrLf & Err.Number & ": " & Err.Description
    Resume ExitErr
End Sub

Open in new window

testfile-macro.xlsm
0
 

Author Closing Comment

by:woodsboro_kid
ID: 38815539
Perfect! Thanks a lot!
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article lists the top 5 free OST to PST Converter Tools. These tools save a lot of time for users when they want to convert OST to PST after their exchange server is no longer available or some other critical issue with exchange server or impor…
Read this checklist to learn more about the 15 things you should never include in an email signature.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

820 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question