Como extraer un email de un texto en Visual Basic
4986
post-template-default,single,single-post,postid-4986,single-format-standard,ajax_fade,page_not_loaded,,vertical_menu_enabled,side_area_uncovered_from_content,qode-theme-ver-11.0,qode-theme-bridge,wpb-js-composer js-comp-ver-5.0.1,vc_responsive

Como extraer un email de un texto en Visual Basic

Como extraer un email de un texto en Visual Basic

Esta es una función que suelo utilizar para extraer emails de texto. Es la versión simplificada para encontrar un solo email ya que con una modificación en el Gosub puede capturar un número indeterminado de emails y almacenarlos en una colección de objetos.

La función también sirve de ejemplo para la utilización de varias sentencias de manejo de strings en Visual Basic: Instr, Len, Mid y Asc

Public Function CapturarEmailTexto(Texto) As String
    Dim indPos As Long
    Dim indDesde As Long
    Dim indHasta As Long
    Dim strEmail As String
    Dim strInt   As String
    On Error GoTo ErrorSub
    CapturarEmailTexto = ""
    strEmail = ""
    If InStr(1, Texto, "@") = 0 Then Exit Function
    For indPos = 1 To Len(Texto)
        If Mid(Texto, indPos, 1) = "@" Then
            GoSub Captura
            Exit For
        End If
    Next
    CapturarEmailTexto = strEmail
    Exit Function
Captura:
    indDesde = 0
    indHasta = 0
' Buscar Inicio de Email
    For indDesde = indPos - 1 To 0 Step -1
        If indDesde = 0 Then Exit For
        strInt = Mid(Texto, indDesde, 1)
        If strInt = " " Then Exit For
        If strInt = ":" Then Exit For
        If strInt = "(" Then Exit For
        If strInt = ")" Then Exit For
        If strInt = "[" Then Exit For
        If strInt = "]" Then Exit For
        If strInt = "<" Then Exit For
        If strInt = ">" Then Exit For
        If strInt = """" Then Exit For
        If strInt = "'" Then Exit For
        If Asc(strInt) = 13 Then Exit For ' Control de Return
        If Asc(strInt) = 10 Then Exit For ' Control de Return
    Next
' Buscar Final de Email
    For indHasta = indPos + 1 To Len(Texto)
        strInt = Mid(Texto, indHasta, 1)
        If strInt = " " Then Exit For
        If strInt = ":" Then Exit For
        If strInt = "(" Then Exit For
        If strInt = ")" Then Exit For
        If strInt = "[" Then Exit For
        If strInt = "]" Then Exit For
        If strInt = "<" Then Exit For
        If strInt = ">" Then Exit For
        If strInt = """" Then Exit For
        If strInt = "'" Then Exit For
        If Asc(strInt) = 13 Then Exit For ' Control de Return
        If Asc(strInt) = 10 Then Exit For ' Control de Return
    Next
' Determinar Mail
    strEmail = Mid(Texto, indDesde + 1, indHasta - indDesde - 1)
' Eliminar Caracteres Finales incorrectos
    If Right(strEmail, 1) = "." Then strEmail = Mid(strEmail, 1, Len(strEmail) - 1)
    If Right(strEmail, 1) = "," Then strEmail = Mid(strEmail, 1, Len(strEmail) - 1)
    Return
ErrorSub:
    MsgBox Err.Number & ": " & Err.Description
End Function
1 Star2 Stars3 Stars4 Stars5 Stars (1 votes, average: 5,00 out of 5)
Cargando…
No Comments

Deja un comentario

Uso de cookies

Este sitio web utiliza cookies para que usted tenga la mejor experiencia de usuario. Si continúa navegando está dando su consentimiento para la aceptación de las mencionadas cookies y la aceptación de nuestra política de cookies, pinche el enlace para mayor información.plugin cookies

ACEPTAR
Aviso de cookies
Ver botones
Ocultar botones