Sub Email()

            Dim OutApp As Object
            Dim OutMail As Object
            Dim cell As Range
            Dim Src As Worksheet

            Application.ScreenUpdating = False
        Set OutApp = CreateObject("Outlook.Application")
        Set Src = ThisWorkbook.Sheets("List")

        On Error GoTo cleanup

        Src.Select
        For Each cell In Columns("C").Cells.SpecialCells(xlCellTypeConstants)
            If cell.Value Like "?*@?*.?*" Then

                Set OutMail = OutApp.CreateItem(0)
                On Error Resume Next
                With OutMail
                    .To = cell.Value
                    .Subject = "Splunk Access"
                    .Body = "Hi " & Cells(cell.Row, "A").Value _
                        & vbNewLine & vbNewLine & _
                            "I have created an account: Production." & _
                        vbNewLine & vbNewLine & _
                            "Your username and password for this environment is:" & _
                        vbNewLine & vbNewLine & _
                            "Username: " & Cells(cell.Row, "B").Value & _
                        vbNewLine & _
                            "Password: " & Cells(cell.Row, "E").Value & _
                        vbNewLine & vbNewLine & _
                            "Please log in at your earliest convenience and change your password to a more secure one. " & _
                        vbNewLine & vbNewLine & _
                            "You can do this by clicking on your name on the top menu and select ‘Edit Account’." & _
                        vbNewLine & vbNewLine & _
                            "You can use this link to get to the log in page for this environment: " & _
                        vbNewLine & vbNewLine & _
                            "PROD: right/en-US/account/logout " & _
                        vbNewLine & vbNewLine & _
                            "Many thanks and kind regards"
                        .send
                End With
                On Error GoTo 0
                Set OutMail = Nothing
            End If
            Next cell

    cleanup:
                Set OutApp = Nothing
                Application.ScreenUpdating = True
    End Sub

.send

.Display
Application.Wait (Now + TimeValue("0:00:01"))
Application.SendKeys "%"