How to paste specific cell value from an Excel worksheet into Outlook Subject line using a Macro?-CodePudding

I am trying to add specific cell values from an Excel worksheet into my predefined Outlook subject line however I am struggling with the right macro code for it. Can anyone help?

Here's the code that I am using to create an Outlook email and copy specific table and chart from an Excel worksheet:

Sub Open_Outlook_and_Create_Email()

'open outlook
Dim oOutlook As Object
Set oOutlook = CreateObject("Outlook.Application")

'open Email
Dim oEmail As Object
Set oEmail = oOutlook.CreateItem(o1MailItem)


With oEmail
.To = "[email protected]"
.Subject = "ABC Flash Report 2018-2-5: ABC Occ. 99% / AB (44,11) 
-40.6% / BC (49,3,17,2,0,12) -1.2% / CD (9,0) -37.4% / DE (0,12,0) 
3.7% / EF (11,8) -30.6% / FH (14,6) -3.6% / IJ (4,2) -69.5%"
.Body = ""
.Display

Dim oOutlookInspect As Outlook.Inspector
Dim oWordDoc, oWordDoc1 As Word.Document
Dim oChartobj As ChartObject

Set oChartobj = ActiveSheet.ChartObjects("Chart 7")
oChartobj.Chart.ChartArea.Copy

Set oOutlookInspect = .GetInspector
Set oWordDoc = oOutlookInspect.WordEditor

Set oWordRng = oWordDoc.Application.ActiveDocument.Content
oWordRng.InsertAfter " " & vbNewLine
oWordRng.Collapse Direction:=wbCollapseEnd
oWordRng.Paste


Set oOutlookInspect = .GetInspector
Set oWordDoc1 = oOutlookInspect.WordEditor

ActiveSheet.Range("ProjData").Copy

Set oWordRng1 = oWordDoc1.Application.ActiveDocument.Content
oWordRng1.InsertAfter " " & vbNewLine
oWordRng1.Collapse Direction:=wbCollapseEnd
oWordRng1.Paste

'.Send
End With

'Clear the objects
Set oEmail = Nothing
Set oOutlook = Nothing

Errhandler:

End Sub

More specifically, I am looking for a Macro code that can update the percentages (%) in my Outlook email subject line with particular cell values from an Excel worksheet.

Look forward to your input.

Thanks, K

I tried the above Macro and the result is as expected that it open the Outlook email and copies the relevant chart and table from an Excel file. However, it doesn't copy and paste the relevant cell values from the Excel worksheet into the Outlook email subject line.

CodePudding user response：

The most basic and brute force method is just to capture all those values as variables (keeping in mind I'm not sure which cells contain the data) then whacking them all together as a string subject variable.
This gives you a reasonable amount of control... however, to make it easier for regular users to manage, I often try to "Build" my subject in a cell in my workbook, then just import that cell's value into my sSubject variable.

Option Explicit
Sub Open_Outlook_and_Create_Email()

    'open outlook
    Dim oOutlook As Object
    Set oOutlook = CreateObject("Outlook.Application")
    
    Dim oOutlookInspect As Outlook.Inspector
    Dim oWordDoc, oWordDoc1 As Word.Document
    Dim oChartobj As ChartObject
    
    'open Email
    Dim oEmail As Object
    Set oEmail = oOutlook.CreateItem(o1MailItem)
    
    ' Subject and Percentages
    Dim sSubject As String
    Dim ABC_Occ As String
    Dim AB As String
    Dim BC As String
    Dim CD As String
    Dim DE As String
    Dim EF As String
    Dim FH As String
    Dim IJ As String
    
    ' Keep in mind I have no idea where your data is located, _
      so you will need to figure out how to reference it
    With Sheet1
        ABC_Occ = Format(.Range("A1").Value, "0.00") & "%"
        AB = Format(.Range("B1").Value, "0.00") & "%"
        BC = Format(.Range("C1").Value, "0.00") & "%"
        CD = Format(.Range("D1").Value, "0.00") & "%"
        DE = Format(.Range("E1").Value, "0.00") & "%"
        EF = Format(.Range("F1").Value, "0.00") & "%"
        FH = Format(.Range("H1").Value, "0.00") & "%"
        IJ = Format(.Range("I1").Value, "0.00") & "%"
    End With
    
    ' Build Subject Line
    sSubject = "ABC Flash Report 2018-2-5: ABC Occ. " & ABC_Occ & " / AB (44,11) " & AB & _
                " / BC (49,3,17,2,0,12) " & BC & " / CD (9,0) " & CD & " / DE (0,12,0) " & DE & _
                " / EF (11,8) " & EF & " / FH (14,6) " & FH & " / IJ (4,2) " & IJ & ""
    Debug.Print sSubject
    
    With oEmail
    .To = "[email protected]"
    .Subject = sSubject
    .Body = ""
    .Display
    
    Set oChartobj = ActiveSheet.ChartObjects("Chart 7")
    oChartobj.Chart.ChartArea.Copy
    
    Set oOutlookInspect = .GetInspector
    Set oWordDoc = oOutlookInspect.WordEditor
    
    Set oWordRng = oWordDoc.Application.ActiveDocument.Content
    oWordRng.InsertAfter " " & vbNewLine
    oWordRng.Collapse Direction:=wbCollapseEnd
    oWordRng.Paste
    
    
    Set oOutlookInspect = .GetInspector
    Set oWordDoc1 = oOutlookInspect.WordEditor
    
    ActiveSheet.Range("ProjData").Copy
    
    Set oWordRng1 = oWordDoc1.Application.ActiveDocument.Content
    oWordRng1.InsertAfter " " & vbNewLine
    oWordRng1.Collapse Direction:=wbCollapseEnd
    oWordRng1.Paste
    
    '.Send
    End With
    
    'Clear the objects
    Set oEmail = Nothing
    Set oOutlook = Nothing
    
Exit Sub
Errhandler:

End Sub

For Example, I used this data:

And the sub spit out: ABC Flash Report 2018-2-5: ABC Occ. 14.00% / AB (44,11) -58.00% / BC (49,3,17,2,0,12) -7.00% / CD (9,0) -26.00% / DE (0,12,0) -69.00% / EF (11,8) -65.00% / FH (14,6) -13.00% / IJ (4,2) 67.00%