Hi,
I am basically trying to add text from a cell into the body of my email, I have tried doing it myself but have no luck in getting the text to appear.
I am looking to include cell reference D48 from the 'D&P' tab of the current worksheet, and ideally the text from the cell would be be before the hyperlink on the email if possibly
Any help at all would be very much appreciated!
Please see current coding below:
End Sub
I am basically trying to add text from a cell into the body of my email, I have tried doing it myself but have no luck in getting the text to appear.
I am looking to include cell reference D48 from the 'D&P' tab of the current worksheet, and ideally the text from the cell would be be before the hyperlink on the email if possibly
Any help at all would be very much appreciated!
Please see current coding below:
VBA Code:
Sub Compose_Email_VAL_FILE_FULL()
Dim rng As Range
On Error Resume Next
Set rng = Application.InputBox(Prompt:="Select a range to copy", Type:=8)
On Error GoTo 0
If rng Is Nothing Then
Beep
Exit Sub
End If
rng.CopyPicture xlScreen, xlBitmap
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Dim Wb1 As Workbook
Set Wb1 = ThisWorkbook
'back to the first sheet
ThisWorkbook.Sheets(1).Select
'get the name shown in the upper right hand corner of Excel to use as the signature
Dim OwnerName As String
OwnerName = Application.UserName
'get the workbook name
Dim WorkbookName As String
WorkbookName = Wb1.Name
'get the location where the spreadsheet is saved
Dim FileLoc As String
FileLoc = Wb1.FullName
Dim FName As String
FName = Sheets("Summary Sheet").Range("C4").Text
'time to start Mircosoft Outlook if it hasn't already been started
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
'for non-html email
'xMailBody = "Team, " & vbNewLine & vbNewLine & "Please check and sign this DCN:" & vbNewLine & "Thanks," & vbNewLine & OwnerName
'for html email. This is the body of the email
xMailBody = "Hi All, <br><br>" & FName & " " & "Validation File" & " " & "is ready for auth:" & "<br><br>" & _
"<a href=" & Chr(34) & FileLoc & Chr(34) & " > " & WorkbookName & " </a> " _
& "<br><br>" & "Thanks," & "<br><br>" & OwnerName
'fill in each section of the newly created email message
On Error Resume Next
With xOutMail
.To = "controlevidence.finops@landg.com"
.CC = ""
.BCC = ""
.Subject = WorkbookName
'.Body = xMailBody
.HTMLBody = xMailBody
.Display 'or use .Send
SendKeys ("^{DOWN}")
SendKeys ("^{DOWN}")
SendKeys ("%m")
SendKeys ("v")
SendKeys ("s")
SendKeys ("{UP}")
SendKeys ("{UP}")
SendKeys ("{ENTER}")
SendKeys ("{ENTER}")
SendKeys ("%m")
SendKeys ("q")
SendKeys ("{ENTER}")
Application.SendKeys "(^v)"
SendKeys "{NUMLOCK}", True
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = TrueEnd Sub
