Email selecting in Outlook

Hello All,
I have copied this and made it work for my use but can't seem to select a different email in outlook to send from. I have created a new profile in outlook and even forced outlook to use only this profile but the macro still seems to tag my Exchange Email address. Can someone look at this coding and edit were it would work. I would like to get this working and I'm too new to V Basic to know where to go from here.

Sub Button1_Click()
 Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Columns("e").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           UCase(Cells(cell.Row, "f").Value) = "YES" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .Bcc = cell.Value
                .Subject = "Over Limit"
                .htmlbody = "<b>" & "<font face=""Courier New"" size=""2"" color=""black"">" & "<br/>" & vbLf & _
                "<b>" & "<font face=""Courier New"" size=""2"" color=""black"">" & "XXXXXXX," & "<br/>" & [a3] & "<br/>" & "XXXXXXX" & "</b>" & _
                "<br/>" & "<b>" & "<font face=""Courier New"" size=""2"" color=""black"">" & "XXXXXXXXXXX" & "</b>" & "<br/>" & "will be turned down to 128KB up and down." & _
                "<br/>" & "<b>" & "XXXXXXXXXX" & "</b>" & "<br/>" & "XXXXXXXXXXXX" & _
                "<br/>" & "<br/>" & "<br/>" & "<b>" & "<font face=""Courier New"" size=""2"" color=""black"">" & _
                "Tel: 519-358-4638" & "<br/>" & "Fax: 519-352-2095" & _
                "<br/>" & "e-mail:" & "<font face=""Courier New"" size=""2"" color=""blue"">" & "XXXXX@XXXXXXX.com" & "<br/>" & _
                "<font face=""Courier New"" size=""2"" color=""black"">" & "Website:" & _
                "<font face=""Courier New"" size=""2"" color=""blue"">" & "www.XXXXXX.com" & "</html>" & _
                .Display  'change to "send" when not in TEST mode
                
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub