# send xls to email



## wmtsub (Oct 12, 2018)

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 (Oct 12, 2018)

Hi,
Instead of this code line:

```
objNewEmail.HTMLBody = objTextStream.readall
```
try using of that one:

```
objNewEmail.HTMLBody = Replace(objTextStream.readall, "align=center x:publishsource=", "align=left x:publishsource=")
```
Also mail creation can be done faster in the already open instance of the Outlook by this part of the code:

```
'Create a new email
  On Error Resume Next
  Set objOutlookApp = GetObject( , "Outlook.Application")
  If Err Then Set objOutlookApp = CreateObject("Outlook.Application")
  On Error GoTo 0
```
Regards


----------



## wmtsub (Oct 15, 2018)

Thank you, 
This fixed the alignment issue:  objNewEmail.HTMLBody = Replace(objTextStream.readall, "align=center xublishsource=", "align=left xublishsource=")


I tried the other code and it gave me an error.
​


----------



## wmtsub (Nov 2, 2018)

ZVI,
 If you're still watching this thread I have two more things I am having issues with or if anyone else can helo I wouold appreciate it.​

1] I can not get it to Send the email without my hitting the send button on each email.
2] I would like to ad four lines of text to the top of each email with a salutation.

I tried to add it tto the spreadsheet manually but some how it messes up the output.

or if anyone else can help I wouold appreciate it.


Also if you can explain where this would go  --- faster is always better.

thanks   -Eds


----------



## ZVI (Nov 2, 2018)

Hi, 
Try this code:

```
Sub SendVisibleCells_inOutlookEmail()
' ZVI:2018-11-03 https://www.mrexcel.com/forum/excel-questions/1074013-send-xls-email.html#post5170781
 
  Dim objOutlookApp As Object
  Dim IsOutlookCreated As Boolean
  Dim sHtmlHeader As String, sSignature As String
  Dim sText As String, sTempHTMLFile As String
 
  ' 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
  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
 
  ' Create a new email, fill it and send
  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
  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
    ' Concatenate all parts for HtmlBody
    sText = sHtmlHeader & sText & sSignature
    ' Apply left aligning
    sText = Replace(sText, "align=center x:publishsource=", "align=left x:publishsource=")
    ' Insert sText into HtmlBody
    .HtmlBody = sText
    'Specify email recipients, subject, etc:
    .To = "johnsmith@..."
    '.Cc = "carboncopy@..."
    .Subject = "DataNumen Products"
    .Send '<-- Directly send out this email, use .Display instead for the debugging only
  End With
 
  If IsOutlookCreated Then
    ' Close the created Outlook instance
    objOutlookApp.Quit
    Set objOutlookApp = Nothing
  End If
 
End Sub
```
Regards


----------



## wmtsub (Nov 6, 2018)

Thank you very Much.  I will try it soon.


----------



## wmtsub (Nov 6, 2018)

This is awesome. It is actually faster than before.
Thanks you so much.


----------



## ZVI (Nov 6, 2018)

wmtsub said:


> This is awesome. It is actually faster than before.
> Thanks you so much.


Glad it helped!


----------



## wmtsub (Nov 6, 2018)

You may need to tell me to stop as I keep getting new ideas.... And i do not want to wear out my welcome.

But I have taken your email code an inserted into a macro that parses a worksheet into multiple worksheets based on the vendors name.
I intend to generate emails and populate the body with their pertinent lines of information. But I was wondering if I could set a threshold
so an email will only generate if there is x amount of lines on the spreadsheet. So one day I may email everyone with 10 or more rows of data and the next five or more. is this possible?  I do not really want to email all the vendors all the time.

And is it possibleto specify what email account to send this thru? I have several on my PC.


----------



## ZVI (Nov 6, 2018)

wmtsub said:


> ... set a threshold so an email will only generate if there is x amount of lines on the spreadsheet.


You may start  with the below code which loops sheets in active workbook and if last row with data in the sheet is greater or equal to the defined threshold then that sheet is sending via the previous code.

```
Sub SendConditonally()
 
  Const SheetLinesGE = 10  ' <-- Change threshold to suit, GE means Greater or Equal
 
  Dim Sh As Worksheet, LastDataRow As Long
  For Each Sh In Worksheets
    LastDataRow = Sh.UsedRange.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByRows, _
                   SearchDirection:=xlPrevious, SearchFormat:=False).Row
    If LastDataRow >= SheetLinesGE Then
      Sh.Activate
      SendVisibleCells_inOutlookEmail
    End If
  Next
 
End Sub
```


----------



## wmtsub (Oct 12, 2018)

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


----------



## wmtsub (Nov 7, 2018)

That is just awesome.

One last tweak please. My macro sets the font to arial [10] in excel and fits the colums. But the verssion [html ?] pasted to outlook is changing in to segoe [11] and it is messign my formatting.  I do not mind the larger print but I would need to auto fit the column's and of course the original font / size is ok to. How should I overcome this?  What path is easier?​


----------



## ZVI (Nov 7, 2018)

wmtsub said:


> My macro sets the font to arial [10] in excel and fits the colums. But the verssion [html ?] pasted to outlook is changing in to segoe [11] and it is messign my formatting.


Can't reproduse that behavior. I've formated (font & size) cells individually and their formats are the same as in the Excel sheet.
Apply .Display instead of .Send and check font(s) in Outlook email.


----------



## wmtsub (Nov 7, 2018)

I did as requested, results the same. Excel is formated at Arial 10, outlook is formated as Arial 10 and the pasted date is segoe 12. Cant figure why.
Got a work around, I am reformatting excel to segoe 12.   

Any chance you can tell me how I would specify to email thru a differnet account other than the default email address?


----------



## ZVI (Nov 7, 2018)

wmtsub said:


> Any chance you can tell me how I would specify to email thru a different account other than the default email address?


Last+ tweak? 
Define smtp address of the mailbox to send from in the Const MySmtpAddress on the top of the code

```
Sub SendVisibleCells_inOutlookEmail()
' ZVI:2018-11-08 https://www.mrexcel.com/forum/excel-questions/1074013-send-xls-email.html#post5170781
 
  ' User setting, change to suit
  Const MySmtpAddress = "My.SmtpAddress@send.from" ' <-- The smtp address to send from
 
  Dim objOutlookApp As Object, objAccount As Object
  Dim IsOutlookCreated As Boolean
  Dim sHtmlHeader As String, sSignature As String
  Dim sText As String, sTempHTMLFile As String
 
  ' 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
 
  ' Use mailbox defined by SmtpAddress
  For Each objAccount In objOutlookApp.Session.Accounts
    If LCase(objAccount.SmtpAddress) = LCase(MySmtpAddress) Then Exit For
  Next
  If objAccount Is Nothing Then
    MsgBox "Account " & MySmtpAddress & " not found." & vbLf _
         & "The default account will be used", _
         vbExclamation, "Warning:"
  End If
 
  ' Create a new email, fill it and send
  With objOutlookApp.CreateItem(0)
    ' Use the defined mailbox if found
    If Not objAccount Is Nothing Then .SendUsingAccount = objAccount
    ' Set HTML format
    .BodyFormat = 2
    ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    sSignature = .HtmlBody
    ' Concatenate all parts for HtmlBody
    sText = sHtmlHeader & sText & sSignature
    ' Apply left aligning
    sText = Replace(sText, "align=center x:publishsource=", "align=left x:publishsource=")
    ' Insert sText into HtmlBody
    .HtmlBody = sText
    'Specify email recipients, subject, etc:
    .To = "johnsmith@..."
    '.Cc = "carboncopy@..."
    .Subject = "DataNumen Products"
    .Send '<-- Directly send out this email, use .Display instead for the debugging only
  End With
 
  ' Prevent memory leakage
  Set objAccount = Nothing
 
  ' Quit Outlook instance if it was created by this code
  If IsOutlookCreated Then
    objOutlookApp.Quit
    Set objOutlookApp = Nothing
  End If
 
End Sub
```
Regards


----------



## wmtsub (Nov 8, 2018)

I seem to be having an issue with this addition. I think it may be because the email account is not actually n account but rather an alias created by my IT dept.
IS we revert back to the thast rendition of this script can I we force somehing like SendithAccount = "Account.com"?​


----------



## ZVI (Nov 9, 2018)

Well, then
1. Do you able to logon manually to that different account and send email from it to yourself?
2. If so, then just do right click on address of the received email to see smtp address of that account and use it in the previous code.
Actually you may send email from the default account on behalf of smtp address of your another installed account by inserting .SentOnBehalfOfName = MySmtpAddress before the line with .Send - find it commented in the below code.

And yes it is possible to use name of the account in the code instead of the smtp address, like this:

```
Sub SendVisibleCells_inOutlookEmail()
' ZVI:2018-11-09 https://www.mrexcel.com/forum/excel-questions/1074013-send-xls-email.html#post5170781
 
  ' User setting, change to suit
  Const AccountName = "Account.com" ' <-- Name of the account
 
  Dim objOutlookApp As Object, objAccount As Object
  Dim IsOutlookCreated As Boolean
  Dim sHtmlHeader As String, sSignature As String
  Dim sText As String, sTempHTMLFile As String
 
  ' 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
 
  ' Use mailbox defined by SmtpAddress
  For Each objAccount In objOutlookApp.Session.Accounts
    If LCase(objAccount.DisplayName) = LCase(AccountName) Then Exit For
  Next
  If objAccount Is Nothing Then
    MsgBox "Account " & AccountName & " not found." & vbLf _
         & "The default account will be used", _
         vbExclamation, "Warning:"
  End If
 
  ' Create a new email, fill it and send
  With objOutlookApp.CreateItem(0)
    ' Use the defined mailbox if found
    If Not objAccount Is Nothing Then .SendUsingAccount = objAccount
    ' 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 = 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
 
  ' Prevent memory leakage
  Set objAccount = Nothing
 
  ' Quit Outlook instance if it was created by this code
  If IsOutlookCreated Then
    objOutlookApp.Quit
    Set objOutlookApp = Nothing
  End If
 
End Sub
```
Regards


----------



## wmtsub (Nov 11, 2018)

The email account is not set up in my outlook installation as an account. however when I send an email I can pull the that down on the send from email addresses and have access to it there. Also when retrieving emails it does so under the account.     Also I would like to integrate the signature into another macro. Can you supply just the specific code for taht for me to play with please?


----------



## wmtsub (Nov 11, 2018)

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.


----------



## wmtsub (Nov 12, 2018)

ZVI, I am fustrated. I love your code but can't get it right. I still can not get the format to stop changing on the second version. And I have not yet goten the email accoutn to change. I trimmed the code down to bare essentials to test the email account change [below]. the message box IS displaying the correct account info but it will not pull up / populate the from email field at all. It always reverts back to the default. I guess I can live with the formatting not exactly as I would like it but this is critical.  Can you please help?




' User setting, change to suit
  objAccount = "test email @ ccc.com" ' <-- The smtp address to send from
' Create a new email, fill it and send
  With objOutlookApp.CreateItem(0)
' Use the defined mailbox if found
    MsgBox objAccount
    .SendUsingAccount = objAccount
 ' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    sSignature = .HtmlBody
    .display
  End With


----------



## ZVI (Nov 13, 2018)

wmtsub said:


> The email account is not set up in my outlook installation as an account. however when I send an email I can pull the that down on the send from email addresses and have access to it there. Also when retrieving emails it does so under the account.


Never faced with a such configuration. Have you tried .SentOnBehalfOfName = "your another address"?


----------



## wmtsub (Oct 12, 2018)

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 (Nov 13, 2018)

wmtsub said:


> 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 (Nov 13, 2018)

wmtsub said:


> ... 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 (Nov 14, 2018)

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 (Nov 15, 2018)

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 (Nov 16, 2018)

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 (Nov 16, 2018)

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 (Nov 16, 2018)

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 (Nov 19, 2018)

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


----------



## wmtsub (Nov 19, 2018)

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 (Nov 29, 2018)

wmtsub said:


> 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


----------

