send xls to email

[wmtsub]

I had been using a macro from Ron Debruin to do this but lately it ran real slow. So I found online another macro, trimmed it and added some of Ron's to it. It runs very fast. But the issue is the data it sends to outlook seems to start mid page and goes right. I can not seem to get it to line up at the left of the page. Any one got any ide why?
ths.
-Eds




Sub EmailSendSelectedCells_inOutlookEmail()
'Copy the selection
Set objSelection = Range("A1:Z" & Cells.SpecialCells(xlCellTypeLastCell).Row).SpecialCells(xlCellTypeVisible)
objSelection.Copy
'Paste the copied selected ranges into a temp worksheet
Set objTempWorkbook = Excel.Application.Workbooks.Add(1)
Set objTempWorksheet = objTempWorkbook.Sheets(1)
'Keep the values, column widths and formats in pasting
With objTempWorksheet.Cells(1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteFormats
End With
'Save the temp worksheet as a HTML file
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempHTMLFile = objFileSystem.GetSpecialFolder(2).Path & "\Temp for Excel" & Format(Now, "YYYY-MM-DD hh-mm-ss") & ".htm"
Set objTempHTMLFile = objTempWorkbook.PublishObjects.Add(xlSourceRange, strTempHTMLFile, objTempWorksheet.Name, objTempWorksheet.UsedRange.Address)
objTempHTMLFile.Publish (True)
'Create a new email
Set objOutlookApp = CreateObject("Outlook.Application")
Set objNewEmail = objOutlookApp.CreateItem(olMailItem)
'Read the HTML file data and insert into the email body
Set objTextStream = objFileSystem.OpenTextFile(strTempHTMLFile)
objNewEmail.HTMLBody = objTextStream.readall
objNewEmail.Display
'****************************************************************************************
'Specify email recipients, subjects ; etc, Here
'objNewEmail.To = "johnsmith@"
'objNewEmail.Cc = "carboncopy"
'objNewEmail.Subject = "DataNumen Products"
'objNewEmail.Send '--> directly send out this email
'****************************************************************************************
objTextStream.Close
objTempWorkbook.Close (False)
objFileSystem.DeleteFile (strTempHTMLFile)
End Sub

 

[ZVI]

PS. Also for some reason I have not been able to figure out why the format and fonts are being changed. the version just before did work fine but this one does not.

Please run the code as it's in the post, change only the address in the field .To = "your address" and post what happens.
As your modification of that code is not known to me and can be the reason of the problems.

Just for your info, there are 3 parts of the body in the code:
1. sHtmlHeader - the top lines of the body set by the code.
2. sText - the middle part of the body with a table copied from the Excel published htm-file.
3. sSignature - bottom part of the body with default signature of the email which may include text as well as picture.
Those parts are actually HTML elements , and you may put any formatting html tags to the 1st part only, that is - into sHtmlHeader.
The second part of the HTML code can be analysed by debugging (stored in sText) or in the temporary file in the %TEMP% folder (full pathname is in the sTempHTMLFile).
For more details read the comments in the code.

It's unclear in what parts "format and fonts are being changed", please be more specific.

 

[ZVI]

... the message box IS displaying the correct account info but it will not pull up / populate the from email field at all.

objAccount is not just string, it have to be object of the account.
As it was suggested try .SentOnBehalfOfName = "your another address" but the signature in this case will be the same as for the default account of Outlook.

 

[wmtsub]

I will do so again tomorrow. I am not at that machine. Is there a way i can post pics so I can screenshot the changes for you?

 

[wmtsub]

ZVI, As always - Thanks. Your help is incredible. I recopied your last code and created an new module for it. I ran it and still had the issues. Not sure how to paste screen shots here so I put it on my google drive. https://drive.google.com/open?id=1ryRgMRQeu47ZEbtT5n23rniBvOIblWMk. Hope that will help you.

-Eds

 

[wmtsub]

Playing around with the code, thanks for the explanation. I removed references to

sHtmlHeader as that is all prepared already in the excel sheet.
Then playing with the code sText = sText & sSignature to read instead sText = sSignature & sText the table is inserted after the signature and the formats are kept, no change in font either.

So I suppose it has to do with the signature file?
Can you suggest a fix?


​

 

[wmtsub]

Well I was wrong, It seems to work that way intermitently. But it is deffinetly tied to the signiture. If i rem out the signature line the formates are always perfect. Could it be due to the png attached? Might it be that the signature is appending to the table? Can I add the signature as a separate item?

 

[ZVI]

As it was highlighted early the HTML tags can be used for font setting in the body, like this:

Sub SendRangeInTheBody()
' ZVI:2018-11-17 https://www.mrexcel.com/forum/excel-questions/1074013-send-xls-email.html#post5170781
 
  '--> User setting, change to suit
  Const FontName = "Arial"
  Const FontSize = 10
  Const Behalf = "someone@someplace.com" ' <-- Name to send on behalf of Exchange profile/account
  '<--
 
  Dim objOutlookApp As Object
  Dim IsOutlookCreated As Boolean
  Dim sHtmlHeader As String, sSignature As String
  Dim sFont As String, sText As String, sTempHTMLFile As String
 
  ' Set font of html-body (parentheses are just because of MrExcel posting limitation)
  sFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")(/p)"
  sFont = Replace(sFont, "(", Chr(60))
  sFont = Replace(sFont, ")", Chr(62))
 
  ' Create top lines of the email body
  sHtmlHeader = "Dear Customer," & vbLf & vbLf _
              & "Your order for the products listed in this table is accepted" & vbLf
  sHtmlHeader = Replace(sHtmlHeader, vbLf, Chr(60) & "br" & Chr(62))
  
  'Copy visible range only
  Application.CutCopyMode = False
  ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy
 
  ' Get HTML data
  sTempHTMLFile = Environ("Temp") & "\Temp_for_Excel" & Format(Now, "YYYYMMDD_hhmmssms") & ".htm"
  With Workbooks.Add(xlWBATWorksheet)
    ' Paste data special
    With .Sheets(1).Cells(1)
      .PasteSpecial xlPasteValues
      .PasteSpecial xlPasteColumnWidths
      .PasteSpecial xlPasteFormats
    End With
    Application.CutCopyMode = False
    ' Publish HTML file data
    With .PublishObjects.Add(xlSourceRange, sTempHTMLFile, .Sheets(1).Name, .Sheets(1).UsedRange.Address, xlHtmlStatic)
      .Publish True
    End With
    ' Read the HTML file data
    sText = CreateObject("Scripting.FileSystemObject").OpenTextFile(sTempHTMLFile).ReadAll
    ' Close the created aux workbook
    .Close False
    ' Kill the HTML file
    Kill sTempHTMLFile
  End With
 
  ' Get/Create an Outlook instance
  On Error Resume Next
  Set objOutlookApp = GetObject(, "Outlook.Application")
  If Err Then
    Set objOutlookApp = CreateObject("Outlook.Application")
    IsOutlookCreated = True
  End If
  On Error GoTo 0
 
  ' Create a new email, fill it and send
  With objOutlookApp.CreateItem(0)
    ' Set HTML format
    .BodyFormat = 2
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    sSignature = .htmlbody
    ' Apply left aligning
    sText = Replace(sText, "align=center x:publishsource=", "align=left x:publishsource=")
    ' Concatenate all parts for HtmlBody
    sText = sFont & sHtmlHeader & sText & sSignature
    ' Insert sText into HtmlBody
    .htmlbody = sText
    'Specify email recipients, subject, etc:
    .To = "johnsmith@..."
    '.Cc = "carboncopy@..."
    .Subject = "DataNumen Products"
    '.SentOnBehalfOfName = Behalf
    .Send '<-- Directly send out this email, use .Display instead for the debugging only
  End With
 
  ' Quit Outlook instance if it was created by this code
  If IsOutlookCreated Then
    objOutlookApp.Quit
    Set objOutlookApp = Nothing
  End If
 
End Sub

 

[wmtsub]

AWESOME.... all seems to work perfectly now. Wish I new more so I could learn from what you did..
my thanks

 

[wmtsub]

One tiny issue. When I ran this as a test case [.display] and sent them manually it worked fine. But when I set tht to ['.display] and activated [.send] the emails all stayed in my outbox. I had to go back and manually hit send all from the outbox.
Any idea why?

 

[ZVI]

One tiny issue. When I ran this as a test case [.display] and sent them manually it worked fine. But when I set tht to ['.display] and activated [.send] the emails all stayed in my outbox. I had to go back and manually hit send all from the outbox.
Any idea why?

Read this article - Email stays in the Outbox folder until you manually initiate a send/receive operation in Outlook