For posterity, the 'bazooka' function uses a heavy-duty regular expression (it was Rick who coined it that way in one of our threads, so I'll pass the credit to him for the catchy name).

Just for the record though, the function that I posted (revised one below) will extract more than one email address from the string, should it contain that many.

Code:
Function ExtractEmail(strInputText As String) As String

    Dim regEx As Object
    Dim varResults As Object
    Dim varEach
    Dim lng As Long
    With CreateObject("vbscript.RegExp")
    .Pattern = "(?:[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*|""(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21\x23-\x5b\x5d-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])*"")@(?:(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?|\[(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?|[a-z0-9-]*[a-z0-9]:(?:[\x01-\x08\x0b\x0c\x0e-\x1f\x21-\x5a\x53-\x7f]|\\[\x01-\x09\x0b\x0c\x0e-\x7f])+)\])"
    .IgnoreCase = True 'True to ignore case
    .Global = True 'True matches all occurances, False matches the first occurance
    If .Test(strInputText) Then
        Set varResults = .Execute(strInputText)
        For lng = 1 To varResults.Count
            ExtractEmail = ExtractEmail & varResults.Item(lng - 1).Value & "|||"
        Next
        ExtractEmail = Left(ExtractEmail, Len(ExtractEmail) - Len("|||"))
        ExtractEmail = Join(Split(ExtractEmail, "|||"), ", ")
    End If
    End With
End Function