AngelMike
10-04-2018, 05:30 PM
I am trying to get a table in full format from Excel to Outlook and my code is not copying to html file first as it should. Can someone please have a look. I am a newbie
Sub Email()
Dim P As String
Dim wb As ThisWorkbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets(2)
Dim new_wb As Workbook
Dim rng As Range
Set rng = Range("A1:B18")
Dim rng2 As Range
Dim OLapp As Object
Dim oLMail As Object
Dim myattachments As Object
Dim olMailItem As Object
Dim myfilenamepath As String
Set OLapp = CreateObject("outlook.application")
'Set oLMail = OLapp.cREATEITEM(olMailItem)
Set olMailItem = OLapp.cREATEITEM(0)
Set myattachments = olMailItem.attachments
P = "C:\Users" & Environ("Username") & "\Desktop\tempfile.htm"
Workbooks.Add
Set new_wb = ActiveWorkbook
'new_wb.Sheets(2).UsedRange.Address
ThisWorkbook.Activate
rng.Copy
new_wb.Activate
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.PasteSpecial xlPasteFormats
ActiveCell.PasteSpecial xlPasteColumnWidths
new_wb.PublishObjects.Add(xlSourceRange, P, new_wb.Sheets(2).Name, new_wb.Sheets(2).UsedRange.Address, xlHtmlStatic).Publish (True)
With olMailItem
.To = Distribution
.CC = ccDistribution
''.Subject = "Test"
.Subject = "Booking Sheet for" & "" & Range("A1").Value & "" & Range("B1").Value
.Body = "This is a test"
''.attachments ()
myfilenamepath = Application.GetOpenFilename()
myattachments.Add myfilenamepath
.Display
End With
End Sub
Thanks for your help!
Sub Email()
Dim P As String
Dim wb As ThisWorkbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets(2)
Dim new_wb As Workbook
Dim rng As Range
Set rng = Range("A1:B18")
Dim rng2 As Range
Dim OLapp As Object
Dim oLMail As Object
Dim myattachments As Object
Dim olMailItem As Object
Dim myfilenamepath As String
Set OLapp = CreateObject("outlook.application")
'Set oLMail = OLapp.cREATEITEM(olMailItem)
Set olMailItem = OLapp.cREATEITEM(0)
Set myattachments = olMailItem.attachments
P = "C:\Users" & Environ("Username") & "\Desktop\tempfile.htm"
Workbooks.Add
Set new_wb = ActiveWorkbook
'new_wb.Sheets(2).UsedRange.Address
ThisWorkbook.Activate
rng.Copy
new_wb.Activate
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.PasteSpecial xlPasteFormats
ActiveCell.PasteSpecial xlPasteColumnWidths
new_wb.PublishObjects.Add(xlSourceRange, P, new_wb.Sheets(2).Name, new_wb.Sheets(2).UsedRange.Address, xlHtmlStatic).Publish (True)
With olMailItem
.To = Distribution
.CC = ccDistribution
''.Subject = "Test"
.Subject = "Booking Sheet for" & "" & Range("A1").Value & "" & Range("B1").Value
.Body = "This is a test"
''.attachments ()
myfilenamepath = Application.GetOpenFilename()
myattachments.Add myfilenamepath
.Display
End With
End Sub
Thanks for your help!