Pasting Multiple Ranges into Outlook Using Excel VBA

[junebaby1]

Hello!

I've been searching the internet trying to figure out the answer to what I feel is a fairly simple question for those who are actually skilled in the mystic arts of VBA coding. I'm currently using Ron's BuildToHTML Coding in "Example 1" (as can be seen here: http://www.rondebruin.nl/mail/folder3/mail4.htm ) but I'm unable to tweek the coding to paste multiple ranges into the same outlook body.

For clarification, I have 2 charts in different tabs: Sales & Purchases. Following Ron's code I can change the coding so it copies Sales but I am unable to code the macro to paste the Purchases chart in the same outlook directly below Sales. Any help at all will be appreciated, thanks!

Sub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
'Set rng = Sheets("YourSheet").Range("D4:D12").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 = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[deg007]

Just create another range

Dim Rng2 As Range
Set Rng2 = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)

 

[huck9]

Deg007 et al,

I've also spent a lot of time trying to answer this question. If two ranges were created, how would you pull them both into the outlook email? Would the call line for the email be similar to below? Thanks a lot!!

Cheers,


.HTMLBody = RangetoHTML(rng, Rng 2)

 

[VoG]

Possibly

.HTMLBody = RangetoHTML(union(rng, Rng 2))

 

[Kenny7sccr]

Sorry to re-vamp this thread, but when I use the Union it makes my body blank. I can set the range to rng or rng2 and they will populate correctly. Anyone ever solve this?

 

[Kenny7sccr]

Union seems to not work because it needs to be on the same sheet.

 

[Kenny7sccr]

Hello all just wanted to say I found an answer to whoever is also looking for an answer. I just added the HTML body twice.

.HTMLBody = RangetoHTML(Rng 2)
.HTMLBody = RangetoHTML(rng)

 

[gpalko]

HTMLBody resets all the content of the body, so if you copy HTMLBody twice, it just copies the last content.

Any idea?

 

[daverunt]

Hi,

Here's an example I have used before. Change ranges to suit obviously

Set rng = Range("A6:D6").SpecialCells(xlCellTypeVisible)
Set rng2 = Range("A13:D14").SpecialCells(xlCellTypeVisible)

Set rng3 = Union(rng, rng2)


Outlook......
.HTMLBody = RangetoHTML(rng3)

 

[daverunt]

Just tried that with different worksheets for the ranges and it doesn't work because as stated previously Union only works for the same sheet.

So to get around that I add a sheet and copy the ranges to it, RangetoHTML the used range, then delete the sheet.

   Set ws1 = ActiveWorkbook.Sheets.Add
   
   Worksheets("Sheet7").Range("A6:E7").Copy Destination:=Worksheets(ws1.Name).Range("A1")
   
   LastRow = Worksheets(ws1.Name).Cells(Rows.Count, 1).End(xlUp).Offset(1).row
   
   Worksheets("Sheet8").Range("A1:E2").Copy Destination:=Worksheets(ws1.Name).Cells(LastRow, 1)

   Set rng = ws1.UsedRange

'E-mail code start

----.HTMLBody= RangetoHTML(rng) 

'E-mail code end

'Delete the added sheet

    Application.DisplayAlerts = False
    Sheets(ws1.Name).Delete
    Application.DisplayAlerts = True