RangetoHTML and checkboxes

[katsdelite]

This is my first post so please bear with me. I've recently started using VBA mostly by searching for what I need and copying code that fits. I have a sheet that is fillable and uses checkboxes to select certain data. I have a macro that takes the range of data and creates the email with a signature and it works perfectly except the checkboxes don't carry over. Any help would be appreciated!

Sub CreateEmail()
'
' CreateEmail Macro
'

Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Dim Signature As Variant

On Error Resume Next

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)

With xOutMail
.To = "me@myjob.com"
.Subject = "RePull Request" & " " & Range("C5") & " " & Range("C6")
.Display
Signature = .htmlbody
.htmlbody = RangetoHTML(Sheets("RePull Request").Range("A1:C16")) & Signature
.Display

End With


On Error GoTo 0

Set xOutMail = Nothing
Set xOutApp = Nothing

End Sub

Function RangetoHTML(rng As Range)

' Working in Office 2000-2016
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to paste the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center xublishsource=", _
"align=left xublishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing

End Function

 

[Domenic]

Hi katsdelite,

I would suggest that you either copy the range and paste it as a picture within the body of your email or you export the range as an image file and then attach it your email.

If you need help with either of these suggestions, post back and some one will be able to help you.

Cheers!

 

[katsdelite]

Hi katsdelite,

I would suggest that you either copy the range and paste it as a picture within the body of your email or you export the range as an image file and then attach it your email.

If you need help with either of these suggestions, post back and some one will be able to help you.

Cheers!

 

[katsdelite]

Thank you Domenic. I assume that there is no way to do that without making it a picture or attachment? I like having it copy over right into the body of the email where changes can be made to the data if needed before sending. I tried conditional formatting and while it works in the excel file, the formatting doesn't carry over.

If it's the only workaround, I'll manage it. Was just hoping for a cleaner solution.