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
        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

Users are saying about us...

  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?


  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 *

Terms and Conditions of use

The applications/code on this site are distributed as is and without warranties or liability. In no event shall the owner of the copyrights, or the authors of the applications/code be liable for any loss of profit, any problems or any damage resulting from the use or evaluation of the applications/code.

Visit Us On TwitterVisit Us On FacebookVisit Us On Youtube