DONUT PROJECT 2015 - Extraindo e-Mails - Extracting An Email Address From Text

DONUT PROJECT 2015 - Extraindo e-Mails - Extracting An Email Address From Text

​
​

Muito útil para o envio automatizado de e-mails a partir de uma planilha sem higienização apropriada.

Function ExtractEmailAddress (s As String) As String      Dim AtSignLocation As Long      Dim i As Long      Dim TempStr As String      Const CharList As String = "[A-Za-z0-9._-]"            'Get location of the @      AtSignLocation = InStr(s, "@")      If AtSignLocation = 0 Then          ExtractEmailAddress = "" 'not found      Else          TempStr = ""          'Get 1st half of email address          For i = AtSignLocation - 1 To 1 Step -1              If Mid(s, i, 1) Like CharList Then                  TempStr = Mid(s, i, 1) & TempStr              Else                  Exit For              End If          Next i          If TempStr = "" Then Exit Function          'get 2nd half          TempStr = TempStr & "@"          For i = AtSignLocation + 1 To Len(s)              If Mid(s, i, 1) Like CharList Then                  TempStr = TempStr & Mid(s, i, 1)              Else                  Exit For              End If          Next i      End If      'Remove trailing period if it exists      If Right(TempStr, 1) = "." Then TempStr = _         Left(TempStr, Len(TempStr) - 1)      ExtractEmailAddress = TempStr  End Function

Ei! Envie seus comentários e sugestões de artigos. Compartilhe este artigo com seus chefes, colegas de trabalho e amigos.










andredinizbernardes@gmail.com