I have code below to generate an email and the body is extracted using the range name "Bodytext" and then to extract data in E1 to last row in Col G and paste this as a table after the last text in the body of the email.
I need help with the following
1) The range name body text to appear in the body of the email with the same page breaks as the named range "bodyText"
2) The Ageing in Col F to be shown with zero decimals when pasted in the body of the email
I have shared the link below
I have also posted on
Your assistance is most appreciated
I need help with the following
1) The range name body text to appear in the body of the email with the same page breaks as the named range "bodyText"
2) The Ageing in Col F to be shown with zero decimals when pasted in the body of the email
Code:
Sub Email_Report()
ThisWorkbook.Activate ' Start in THIS workbook
Dim zSubject As String
Dim OutApp As Object, OutMail As Object
Dim zText As String
Dim lastRow As Long, i As Long
Dim regex As Object, matches As Object, match As Object
' Read subject from named cell
zSubject = Sheets("Email").Range("subjectText").Value
' Read body text from cell B2 ("BodyText") on sheet "Email"
zText = Sheets("Email").Range("BodyText").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With ThisWorkbook.Sheets("Email")
lastRow = .Cells(.Rows.Count, "E").End(xlUp).Row ' Find the last row in column E
' Initialize the email body with the content from "BodyText"
zText = "<html><body>" & Replace(zText, vbCrLf, "<br>") & "</body></html>"
' Add the table header to the email body
zText = zText & "<br><br><html><table border='1' cellpadding='5'><tr><th>Reference</th><th>Ageing</th><th>Amount</th></tr>"
' Add the data from F1 to last row in column G to the email body as table rows
For i = 2 To lastRow ' Start from row 2 to skip headers
zText = zText & "<tr><td>" & .Cells(i, "E").Value & "</td><td>" & .Cells(i, "F").Value & "</td><td>" & .Cells(i, "G").Value & "</td></tr>"
Next i
' Close the table tag and complete the email body
zText = zText & "</table></html>"
' Use regular expression to add line breaks after periods that are not part of a number
Set regex = CreateObject("VBScript.RegExp")
regex.Global = True
regex.IgnoreCase = True
regex.Pattern = "([^0-9])\.\s"
If regex.Test(zText) Then
Set matches = regex.Execute(zText)
For Each match In matches
' Check if the match is followed by a number, indicating a decimal number
If IsNumeric(Mid(zText, match.FirstIndex + Len(match.Value) + 1, 1)) Then
' Do not add line breaks
Else
' Add two line breaks after the period
zText = Replace(zText, match.Value, match.Value & "<br><br>")
End If
Next match
End If
End With
With OutMail
ActiveWorkbook.Save
.To = Sheets("Email").Range("N1").Value
.CC = Join(Application.Transpose(Sheets("Email").Range("N2:N5").Value), ";")
.BCC = ""
.Subject = zSubject
.HTMLBody = zText
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End SubI have shared the link below
I have also posted on
Macro to Paste data in Body of Email before Regards
I have the following code below I need this amended so that it copies and pastes the data from F1 to last row in Col G on sheet "Email" in the body of the email before text "Regards" or if difficult, to be at the emd of the email Sub Email_Report() ThisWorkbook.Activate...
www.excelforum.com
Your assistance is most appreciated
