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.

in column A - enter sheet or sheets name you want to send.
in column B - enter E-mail address.
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

Harsimran Singh
January 16, 2015 at 11:43 am

Hi

This Code is not Working, i Use Window 7 & Office 2010

Please give Solution. My Contact Number +919780341022

Reply ↓
Yanne
May 29, 2014 at 8:24 am

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

Reply ↓
Giles Walker
March 17, 2014 at 9:30 pm

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

Reply ↓