VBA Code: Text is wrapping in body of email. Can this be prevented?

strangejosh

New Member
Joined
Jul 30, 2022
Messages
15
Office Version
  1. 2019
Platform
  1. Windows
Hello,

I was hoping someone could help me with my code. Thank you for the user @Sequoyah for helping with the original code. That was very helpul.

So basically the code loops through an excel spreadsheet, looks for unique vendors and sends their past due orders to them in the body of an email. It works fine however some of the columns are wrapped while others aren't. Also all of the headers are also wrapped. Is there a way to prevent that from happening for columns / rows?

See below of what the spreadsheet that is to have the code run on it.

Then see what gets returned. Not sure why those 2 columns specifically get wrapped?

Also, is there a way for the code to allow a filter to by applied and then run as normal? Column A Buyer Code may have multiple diferent buyers and say I only want to send emails for specific buyer codes can I filter and just have those send?

See code below.

VBA Code:
Sub mailstrangejosh()



Dim OutApp As Object, OutMail As Object

Dim myRng As Range, v As Variant

Dim j As Long, lastRow As Long

Dim strbody As String



Application.ScreenUpdating = False



lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

v = Range("A1:V" & lastRow).Value



Set OutApp = CreateObject("Outlook.Application")

With CreateObject("scripting.dictionary")

For j = 2 To UBound(v)

If Not .exists(v(j, 2)) Then

.Add v(j, 2), Nothing



strbody = "Hello " & v(j, 20) & “,” & "<br>" & _

"<br>" & _

"Please see below past due order(s) balances and provide a status update when you can. Thank you" & "<br/><br>"



With ActiveSheet

.Range("A1").AutoFilter 2, v(j, 2)

Set myRng = .Range("A1:X" & lastRow).SpecialCells(xlCellTypeVisible)



Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = v(j, 21)

.Subject = v(j, 17) & " – PO Balance(s)"

.HTMLBody = strbody & RangetoHTML(myRng)

.display 'to show

'.Send 'to send

End With

End With

End If

Next j



End With



Range("A1").AutoFilter



Application.ScreenUpdating = True

End Sub



Function RangetoHTML(myRng As Range)

Dim fso As Object

Dim ts As Object

Dim TempFile As String

Dim TempWB As Workbook

Dim i As Integer



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



myRng.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

Cells.EntireRow.AutoFit

Cells.EntireColumn.AutoFit

Application.CutCopyMode = False

On Error Resume Next

.DrawingObjects.Visible = True

.DrawingObjects.Delete

On Error GoTo 0

For i = 7 To 12

With .UsedRange.Borders(i)

.LineStyle = xlContinuous

.ColorIndex = xlAutomatic

.TintAndShade = 0

.Weight = xlMedium

End With

Next i

End With



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



Set fso = CreateObject("Scripting.FileSystemObject")

Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

RangetoHTML = ts.readall

ts.Close

RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")

RangetoHTML = Replace(RangetoHTML, "display:none", "")



TempWB.Close savechanges:=False



Kill TempFile



Set ts = Nothing

Set fso = Nothing

Set TempWB = Nothing



End Function
 

Attachments

  • 666.jpg
    666.jpg
    79.8 KB · Views: 18
  • 777.jpg
    777.jpg
    108.3 KB · Views: 19
I'm digging up the old thread to share my findings on the subject with you. I have the same problem.

I was able to determine that the wrapping happens when you set the HTMLBody property of the MailItem object. So the wrapping is generated internally by the Outlook.Application object.

All lines with more than 119 characters (in my case) are enclosed in the generated email with paragraph tags (<p></p>). This creates additional spacing where there should be none.

In the options of the Outlook desktop app, I found a property that specifies the number of characters above which a line should be automatically wrapped (Options -> Email -> Message Format). If the Outlook MailItem object in VBA also had this property, it might be possible to influence the wrapping. Unfortunately, I have not yet found such a property.

Greetings, Peter
 
Upvote 0

Forum statistics

Threads
1,226,775
Messages
6,192,932
Members
453,767
Latest member
922aloose

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top