Excel Forum

Want to send a range in a sheet with Outlook. But I want to give the user an option for attachment or copy

robert alvarez

Member

Members

Forum Posts: 16

Member Since:
May 11, 2019

Offline

February 21, 2020 - 6:53 am

I have a tool in which the user clicks a macro button and it send out the range of the sheet in the body of an email in Outlook.

We are having an issue that sometimes the range can be over 1000 rows long. The receiver will have to copy paste it in a workbook anyways, so I wanted to give the sender the option with a MsgBox to select if they want the range sent as an attachment or in the body of the Outlook email

below is the code that I have:

Sub Main()

Dim rng As Range

Dim OutApp As Object

Dim OutMail As Object

Dim lastRow As Long

Set rng = Nothing

On Error Resume Next

lastRow = Sheets("Sheet1").Columns(1).Find("*", , xlValues, , xlByRows, xlPrevious).Row

Set rng = Sheets("Sheet1").Range("A1:F" & lastRow).SpecialCells(xlCellTypeVisible)

On Error GoTo 0

If rng Is Nothing Then

MsgBox "The selection is not a range or the sheet is protected" & _

vbNewLine & "please correct and try again.", vbOKOnly

Exit Sub

End If

With Application

.EnableEvents = False

.ScreenUpdating = False

End With

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

With OutMail

.To = Sheets("Contacts").Range("F4").Value

.CC = "isaac.santos@expeditors.com,sju-ivm@expeditors.com"

.BCC = ""

.Subject = "Expeditors Statement"

.HTMLBody = RangetoHTML(rng)

.Display

End With

On Error GoTo 0

With Application

.EnableEvents = True

.ScreenUpdating = True

End With

Set OutMail = Nothing

Set OutApp = Nothing

End Sub

Catalin Bombea

Iasi, Romania

Member

Dashboards

Power Query

Power Pivot

Xtreme Pivot Tables

Excel for Decision Making

Excel for Finance

Excel Analysis Toolpak

Power BI

Excel

Word

Outlook

Excel Expert

Excel Customer Service

PowerPoint

Forum Posts: 1944

Member Since:
November 8, 2013

Offline

February 24, 2020 - 2:15 pm

Hi Robert,

You can replace the line

.HTMLBody = RangetoHTML(Rng)

with:

If MsgBox("Send as attachment?", vbYesNo, "Sending Data") = vbYes Then
.Attachments.Add RangeToNewBook(Rng)
Else
.HTMLBody = RangetoHTML(Rng)
End If

And here is the function that creates the new book:

Function RangeToNewBook(ByVal Rng As Range) As String
Dim Wb As Workbook
Set Wb = Workbooks.Add
Rng.Copy Destination:=Wb.Worksheets(1).Cells(1)
Wb.SaveAs ThisWorkbook.Path & Application.PathSeparator & "Temp " & Format(Now(), "yyyymmddhhmmss") & ".xlsx"
RangeToNewBook = Wb.FullName
Wb.Close True
End Function