Macro sending email from different email address.

Hello!

I have a macro that sends out an email from Outlook. I have two email addresses set up on my desktop Outlook account. Is it possible to have the macro specify which email address to send from? At the moment, I always have to change it in the email itself (from s.feintuch@hrea.org to training@hrea.org) and am wondering if it would be possible to not have to do this. Thanks!

 Sub SaveAsPDF()
    Dim sPath As String
    Dim sInv As String
    Dim rF As Range
    Dim sFile As String
    Dim sPCell As String
    Dim sResp As String

        sInv = ActiveSheet.Range("D17").Value
        Set rF = Worksheets("InvoicesDue").Range("B:B").Find(What:=sInv, LookAt:=xlWhole, LookIn:=xlValues)
        sPath = "\\hrea.sharepoint.com@SSL\DavWWWRoot\FinanceDocs\ELearning\Invoices"
        sFile = Replace(rF.Offset(0, -1) & "_" & rF.Offset(0, 13) & "_Invoice_" & Format(StrConv(rF.Offset(0, 3), vbProperCase), "DD-MMMM-YYYY") & "_" & rF.Offset(0, 1) & ".pdf", " ", "_")
        Application.ScreenUpdating = False
        ActiveSheet.Copy
        ActiveSheet.Buttons.Delete
        sPCell = ActiveSheet.UsedRange.Cells(1).Address
        ActiveSheet.UsedRange.Copy
        ActiveSheet.Range(sPCell).PasteSpecial xlPasteValues
        ActiveSheet.Range(sPCell).Select
        Application.CutCopyMode = False
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=sPath & "/" & sFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        ActiveWorkbook.Close False
        Application.ScreenUpdating = True
        sResp = MsgBox("File saved as an PDF file at:" & vbCr & sPath & vbCr & vbCr & _
                "Do you want to create an email with the PDF attached to send?", vbYesNo + vbInformation)
        If sResp = vbYes Then
            Sheets("Email").Range("B1").Value = sInv
            Dim OutApp As Object
            Dim OutMail As Object
            Set OutApp = CreateObject("Outlook.Application")
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = Sheets("Email").Range("D2").Value
                .CC = ""
                .BCC = ""
                .Subject = Sheets("Email").Range("D5").Value
                .Body = Sheets("Email").Range("D7").Value
                .Attachments.Add sPath & "/" & sFile
                .Display
            End With
            On Error GoTo 0
        
            Set OutMail = Nothing
            Set OutApp = Nothing
        End If
    End Sub

Dear Martin,

Sorry, I should have specified that I´m new to all of this! Is there a line I add in to the code to specify the SenderEmailAddress? I tried putting .From=training@hrea.org, but I'm clearly doing something wrong.

Thanks!