Excel range/cell or cell value/data to copy into a certain outlook OFT Template body

new11

New Member
Joined
Sep 15, 2020
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hey guys, I hope everyone is keeping well!
I was just wondering if anyone might be able to lend a hand or point me into the right direction, please? 😊

I have been experimenting with a few different ways that I could send excel data using VBA but have been struggling with this for some time now.

After experimenting with different methods: “Emailing a range as a picture” and “emailing an entire range, (“A1:J45”) “ I decided to use a method that makes Excel open an “OFT template” and send that along with an attachment however, I don’t know how or if it’s even possible to copy a cell’s value/data and paste that into a certain spot/place in the body of the email?

My Outlook OFT template is mostly made up of an “11X45” table with a whole lot of formatting/layout, basically I am trying to copy a cell’s value into a certain spot when excel opens and creates an email using the OFT file.

Many thanks in advance for any assistance or advice given & remember to stay safe!
P.S: Super new to VBA and coding in general, also my apologies if I haven’t quite worded my question correctly 😊
(*All credit goes to Ron de Bruin)


VBA Code:
Sub emailoft()

Dim otlApp As Object
    Set otlApp = CreateObject("Outlook.Application")
Dim otlNewMail As Object
Set otlNewMail = otlApp.CreateItemFromTemplate("C:\Users\Desktop 08B3780\School\BMIHMS\Year1\BUS102\Term2\Excel\Templates\Outlook Templates\Best Outlook Template OFT.oft")
    With otlNewMail
    vTemplateBody = otlNewMail.HTMLbody
    vTemplateSubject = otlNewMail.Subject
    .Close 1
    End With   
Dim Sheet1 As Worksheet
    Set Sheet1= ActiveWorkbook.Worksheets("Sheet1")
Dim Sheet2 As Worksheet
    Set Sheet2 = ActiveWorkbook.Worksheets("Sheet2")
Dim Password As String
    Password = Split(Sheet1.Range("N11").Value, " ")(0)
Dim Email As Worksheet
    Set Email = ActiveWorkbook.Worksheets("Email")
    Sheet1.Unprotect Password
    Sheet2.Unprotect Password
    Email.Unprotect Password
Dim Y As Double
    Y = DateValue(Now)
Dim strPath As String
    strPath = Environ$("temp") & "\"
Dim strFName2 As String
    strFName2 =  "Subject Test" & Y & ".pdf"
Dim GroupAssessment As String
    GroupAssessment = Sheet2.Range("j20").Value
Dim DateMod As String
    DateMod = Sheet2.Range("I25").Value

Dim month As String
    month = Sheet2.Range("I25").Value
    Sheet2.Range("I25").Value = month
    month = Format(Date, "mmm yyyy")

Sheet2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strPath & strFName2, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  
    Application.ScreenUpdating = False
    ActiveWorkbook.RefreshAll
    Application.ScreenUpdating = True
    Application.ScreenUpdating = True

Set otlApp = CreateObject("Outlook.Application")
Set otlNewMail = otlApp.CreateItem(0)
With otlNewMail
    '.From = "@outlook.com"
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Set " & month & " {" Y & "}"
    .Sensitivity = 2
    .Categories = ("Red;Green")
    .Body = olFormatHTML
    .BodyFormat = olFormatHTML
    .HTMLbody = vTemplateBody
    .Attachments.Add strPath & strFName2
    .Display   'Use only during debugging ###########
    '.Send     'Uncomment to send e-mail ###########
End With

    On Error GoTo 0
    Set OutApp = Nothing
    Set OutAccount = Nothing
    Application.CutCopyMode = False
    Sheet1.Protect Password
    Sheet2.Protect Password
    Email.Protect Password
    Application.Goto Reference:=Sheets("Sheet1").Range("A1"), Scroll:=True
  
  'AutoSaveBookYear
  
End Sub
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Watch MrExcel Video

Forum statistics

Threads
1,118,272
Messages
5,571,243
Members
412,373
Latest member
HelpPls21NZ
Top