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

[strangejosh]

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.

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

 

[_peter]

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