Emailing subtotaled sections from Excel in Outlook

[jlang11]

Hi! I have in the past emailed subtotaled sections in email but whey were exported into workbooks to a specified folder to be attached to an email. I am wanting to add them to the body of the email. They will all be going to 1 email address (for tracking purposes), to then be forwarded to specific users. I have the code for creating the email itself and the body, I am just having trouble coming up with code for the subtotaled sections and pasting them into the individual email bodies. All I can find when searching is sending specific (named) sections of the spreadsheet.

Ideally I would like the header and the subtotaled section in the body of each email. There are 7 columns and varying number of rows. Below is the (edited) email code I will most likely use minus the pasting of the subtotal sections (may still have to edit some of it)

Sub SendEmail()


Dim OLF As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim ToContact As Outlook.Recipient
Dim lastRow As Long
Dim Msg As String
Dim acct As Object
Dim sHello As String
Dim sBody1 As String
Dim i As Long: i = 2


lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    
    '~~> loop Through the Range in Excel
    For i = 2 To lastRow
        '~~> creates a new e-mail message
        Set olMailItem = OLF.Items.Add


With Sheets("Sheet1")
     sHello = "Hello, " & vbNewLine & vbNewLine & _
    "  Please see the information below ." & vbNewLine & vbNewLine
    
    'email verbiage
     sBody1 = " Please take care of the issues below " & vbNewLine




    'message
    Msg = sDear & sBody1




End With


        With olMailItem
            .Subject = "See the info please" & _
            Sheets("Sheet1").Range("B" & i).Value
	    Set ToContact = .Recipients.Add(Sheets("Sheet1").Range("A" & i).Value) ' add a recipient
            .Body = Msg
            
            olMailItem.SentOnBehalfOfName = "myemail@email.com"
            
            'Set acct = sendAccount("myemail@email.com")
            'If Not acct Is Nothing Then _
                '.SendUsingAccount = acct
             '.Send
            .Display
        End With
    Next
    
    Set ToContact = Nothing
    Set olMailItem = Nothing
    Set OLF = Nothing


End Sub




Function sendAccount(strAccount As String) As Object
Dim olkApp As Object
Dim olkAccount As Object
Dim intIndex As Integer
Dim inspect As Inspector


    Set olkAccount = Nothing
    Set olkApp = CreateObject("outlook.application")
    For intIndex = 1 To olkApp.Session.Accounts.Count
        Set olkAccount = olkApp.Session.Accounts.Item(intIndex)
        If LCase(olkAccount.DisplayName) = LCase(strAccount) Then
            Set sendAccount = olkAccount
            Exit For
        End If
    Next
End Function