E-mail Sheets & attaching word doc

    I have a file, that I send each week to several members of the management. Each person gets a different sheet of that file (excel), along with a covering memo (word document). If I included the e-mail addresses of the persons I want to receive each sheet on that sheet, is there a macro that can autosend the e-mails for me and attaching the word document on it as well??
    PS. I use Microsoft Outlook:puzzled:

    Hi Chris,


    Below You will find a working example which You can adapt for Your solution.


    1. Add a new sheet to the workbook
    2. Create a rangename - rnRecipients
    3. Create a rangename - rnWorksheets
    4. Fill in the e-mailaddress in rnRecipients
    5. Fill in the worksheet-names in rnWorksheets
    6. Switch over to the VB-editor and add a standard-module to the VB-project.
    7. Paste following code into the module and make necessary changes.


    Option Explicit


    Sub Send_XLSheets_Word_Outlook()
    'You need to set a reference to the MS Outlook x.x library via
    'Tools | Reference in the VB-editor.
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnRecipients As Range, rnWorkSheets As Range, rnCell As Range
    Dim stName As String
    Dim i As Long
    Dim olApp As Outlook.Application
    Dim olNewMail As Outlook.MailItem


    Set olApp = New Outlook.Application
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("Sheet1")


    With wsSheet
    'Here we have created a list of recipients.
    Set rnRecipients = .Range("rnRecipients")
    'Here we have created a list of singel worksheets in the active workbook.
    Set rnWorkSheets = .Range("rnWorksheets")
    End With


    Application.ScreenUpdating = False


    For i = 1 To rnRecipients.Count
    Set olNewMail = CreateItem(olMailItem)
    With olNewMail
    'Here we add the recipients.
    .Recipients.Add rnRecipients(i, 1).Value
    .Subject = "Subject: Reports"
    .Body = "As per agreed"
    With .Attachments
    'Here we add the word-memo.
    .Add ThisWorkbook.Path & "\" & "Report.doc"
    .Item(1).DisplayName = "Summery - Report"
    'Here we copy, create a new workbook and add a worksheets.
    stName = rnWorkSheets(i, 1).Value
    wbBook.Worksheets(stName).Copy
    With ActiveWorkbook
    .SaveAs Filename:=stName & ".xls"
    .Close
    End With
    .Add ThisWorkbook.Path & "\" & stName & ".xls"
    .Item(2).DisplayName = "Details - Report"
    End With
    .Save
    .Send
    End With
    Next i


    Set olNewMail = Nothing
    Set olApp = Nothing


    'Delete all the created workbooks
    For i = 1 To rnRecipients.Count
    Kill ThisWorkbook.Path & "\" & rnWorkSheets(i, 1).Value & ".xls"
    Next i


    Application.ScreenUpdating = True
    End Sub