Create Outlook mail with dynamic .Body and static .HTMLBody

see if it helps you, add the rest of yr code ...html and attachment

Sub Button1_Click()

  Dim olApp As Object
  Dim olMail As Object
  Dim rw As Integer
  Dim StringTo As String, StringSubject  As String, StringCC As String
  Dim StringBCC As String, StringBody As String
  Dim wksht As Worksheet

   'Set reference to Outlook and turn off ScreenUpdating and Events
    Set olApp = CreateObject("Outlook.Application")
    
    Set wksht = Worksheets("Sheet1") 'change for yr needs
    
    rw = ActiveCell.Row

    StringTo = wksht.Cells(rw, "a").Value
    StringCC = wksht.Cells(rw, "B").Value
    StringSubject = wksht.Cells(rw, "c").Value
    StringBody = "Dear " & wksht.Cells(rw, "h").Value & vbCrLf & vbCrLf & _
                wksht.Cells(rw, "j").Value & vbCrLf _
               & "Here is my own text" & wksht.Cells(rw, "G").Value & vbCrLf

   'Set email parts to variables
   'On Error Resume Next
    Set olMail = olApp.CreateItem(0)

    With olMail
      .To = StringTo
      .CC = StringCC
      .BCC = StringBCC
      .Subject = StringSubject
      .Body = StringBody
      .Display
     '.Send
    End With

End Sub

part 1

ActiveSheet.Shapes("Rectangle 1").TopLeftCell.Address

rename to whatever the shape is called
will give address of the top left corner of your shape

Nope, sorry guys but all this wont work.

For one, I have about 200 copy&paste shapes, I dont want to go through all of them and assign individual macros where I have to define the shape name. When copying this 200 times I would have to rename from "shape1" to "shape200"... No thanks

For John55's sample, your date is in one row and then split among coumns, my data is in a column and then split across rows. Even when adjusting that, I run into a problem when trying to send both a HTML body as well as a regular outlook body where I just want to greet the recipient ("Dear Mr. / Ms. XXX") with data from the worksheet. Its either normal body or HTMLbody...

Thanks though

EDIT: just played around a bit with application.caller and got a good result with this code:

ActiveSheet.Shapes(Application.Caller).TopLeftCell.address

sorry, I am not a mind reader!