Moving beginning portion of email body to Excel

I pieced together working code to move the body of email to Excel.

My company has a sign off that everyone uses at the bottom of their Outlook emails that is part of the body I pull into Excel. I don't want that part.

Here is an example of what that looks like:

>What a great day
Name
Company
position
address
email links

Public Function IsWorkbookOpen(ByVal argFileName As String) As Boolean
    Dim fileID As Long, errNum As Long
    fileID = FreeFile()
    On Error Resume Next
    Open argFileName For Input Lock Read As #fileID
    errNum = Err.Number
    Close fileID
    IsWorkbookOpen = CBool(errNum)
End Function

Private Sub Items_ItemAdd(ByVal item As Object)
    On Error GoTo ErrorHandler
    Dim Msg As Outlook.MailItem
    If TypeName(item) = "MailItem" Then
        Set Msg = item
        Dim xExcelFile As String
        Dim xExcelApp As Excel.Application
        Dim xWb As Excel.Workbook
        Dim xWs As Excel.Worksheet
        Dim xNextEmptyRow As Integer
        Dim xExcelRange As Excel.Range
        xExcelFile = "C:\Users\placeholder\Desktop\Testing\Test2.xlsx"
    End If
    If IsWorkbookOpen("C:\Users\placeholder\Desktop\Testing\Test2.xlsx") = True Then
        GoTo Skip
    Else
        Set xExcelApp = CreateObject("Excel.Application")
        Set xWb = xExcelApp.Workbooks.Open(xExcelFile)
        Set xWs = xWb.Sheets(1)
        xWs.Activate
        Set xExcelRange = xWs.Range("A1")
        xExcelRange.Activate
        xExcelApp.Visible = True
    End If
Skip:
    MsgBox "New Ticket"
    On Error GoTo ErrHandler
    ' Set Outlook application object.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")
    Dim objNSpace As Object
    Set objNSpace = objOutlook.GetNamespace("MAPI")
    Dim myFolder As Object
    Set myFolder = objNSpace.GetDefaultFolder(olFolderInbox).Folders("Automation").Items
    Dim objItem As Object
    Dim iRows, iCols As Integer
    iRows = 2
    For Each objItem In objNSpace.GetDefaultFolder(olFolderInbox).Folders("Automation").Items
        If objItem.Class = olMail Then
            Dim objMail As Outlook.MailItem
            Set objMail = objItem
            
            Cells(iRows, 1) = objMail.ReceivedTime
            Cells(iRows, 2) = objMail.SenderName
            Cells(iRows, 3) = objMail.SenderEmailAddress
            Cells(iRows, 4) = objMail.To
            Cells(iRows, 5) = objMail.Body
            
        End If
        iRows = iRows + 1
    Next
    Set objMail = Nothing
    Set objOutlook = Nothing
    Set objNSpace = Nothing
    Set myFolder = Nothing
ErrHandler:
    Debug.Print Err.Description
MsgBox "End of sub"
ProgramExit:
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & " - " & Err.Description
    Resume ProgramExit
End Sub

Use InStr function to find the beginning of the unwanted text and copy the text prior to that position using the Left function.