Mail sheet(s) to one or more people using VBA in Microsoft Excel

 

Add new sheet, change the sheet name to mail.
Every mail you want to send will use 3 columns.

  1. in column A – enter sheet or sheets name you want to send.
  2. in column B – enter E-mail address.
  3. in column C – the subject title appears at the top of the E-mail message.

Column A:C enter information for the first mail and you may use columns D:F for the second one.
you can send 85 different E-mails this way (85*3 = 255 columns).

 Sub Mail_sheets()
    Dim MyArr As Variant
    Dim last As Long
    Dim shname As Long
    Dim a As Integer
    Dim Arr() As String
    Dim N As Integer
    Dim strdate As String
    For a = 1 To 253 Step 3
        If ThisWorkbook.Sheets("mail").Cells(1, a).Value = "" Then Exit Sub
        Application.ScreenUpdating = False
        last = ThisWorkbook.Sheets("mail").Cells(Rows.Count, a).End(xlUp).Row
        N = 0
        For shname = 1 To last
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = ThisWorkbook.Sheets("mail").Cells(shname, a).Value
        Next shname
        ThisWorkbook.Worksheets(Arr).Copy
        strdate = Format(Date, "dd-mm-yy") & " " & Format(Time, "h-mm-ss")
        ActiveWorkbook.SaveAs "Part of " & ThisWorkbook.Name _
                            & " " & strdate & ".xls"
        With ThisWorkbook.Sheets("mail")
            MyArr = .Range(.Cells(1, a + 1), .Cells(Rows.Count, a + 1).End(xlUp))
        End With
        ActiveWorkbook.SendMail MyArr, ThisWorkbook.Sheets("mail").Cells(1, a + 2).Value
        ActiveWorkbook.ChangeFileAccess xlReadOnly
        Kill ActiveWorkbook.FullName
        ActiveWorkbook.Close False
        Application.ScreenUpdating = True
    Next a
End Sub


3 thoughts on “Mail sheet(s) to one or more people using VBA in Microsoft Excel

  1. This code is great, and I have been using for 6 months with no issues. I just moved to Windows 7 (and still using Excel 2007 and Outlook 2007) and all of a sudden the VBA is failing. It will now only send the first mail, but no subsequent ones. When the dialogue box pops up, and you click on the debugger, the line of code it shows as a problem is:

    last = ThisWorkbook.Sheets(“mail”).Cells(Rows.Count, a).End(xlUp).Row

    Do you know what the problem is?

    Thanks

  2. Hi,

    I take off the save as part, and kill part , it works. But I can’t save my file.

    save as part
    strdate = Format(Date, “dd-mm-yy”) & ” ” & Format(Time, “h-mm-ss”)
    ActiveWorkbook.SaveAs “Part of ” & ThisWorkbook.Name _
    & ” ” & strdate & “.xls”

    kill part
    Kill ActiveWorkbook.FullName
    ActiveWorkbook.Close False

Leave a Reply

Your email address will not be published. Required fields are marked *

*

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>