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

new11

New Member
Joined
Sep 15, 2020
Messages
24
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
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.

Forum statistics

Threads
1,214,915
Messages
6,122,217
Members
449,074
Latest member
cancansova

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