• Home
 · 
• String Manipulation
 · 
• These functions will extract an email address and url from given text.

These functions will extract an email address and url from given text.

These functions will extract an email address and url from given text.

Rate These functions will extract an email address and url from given text.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'   txtInput = GetHTML (txtInput)
'   txtInput = GetEmail (txtInput)


Public Function GetEmail(Inp As String) As String

Dim chrAt As String
Dim chrOpen As String
Dim chrClose As String
Dim phrHREF As String
Dim phrMailTo As String
Dim strFirst As String
Dim strLast As String
Dim strEmail As String

chrAt = InStr(1, Inp$, "@")
chrOpen = InStr(1, Inp$, "<")
chrClose = InStr(1, Inp$, ">")

phrHREF = InStr(1, Inp$, "<a href=")
phrMailTo = InStr(1, Inp$, Chr$(34) & "mailto:")

strFirst = InStr(1, Inp$, "<a href=" & Chr$(34) & "mailto:")
strLast = InStr(1, Inp$, Chr$(34) & ">")

If chrOpen Then
    If chrClose Then
        If phrHREF Then
            If phrMailTo Then
                If strFirst Then
                    If strLast Then
                    ' Start retreiving email address
                        Inp$ = Mid$(Inp$, phrMailTo + 8)
                        GetEmail$ = Mid(Inp$, 1, InStr(1, Inp$, Chr$(34)) - 1)
                    ' End retreiving email address
                    End If
                End If
            End If
        End If
    End If
End If

End Function


Public Function GetURL(Inp As String) As String

Dim chrOpen As String
Dim chrClose As String
Dim phrHREF As String
Dim strFirst As String
Dim strLast As String
Dim strEmail As String
Dim strHTTP As String

chrOpen = InStr(1, Inp$, "<")
chrClose = InStr(1, Inp$, ">")

phrHREF = InStr(1, Inp$, "<a href=")

strFirst = InStr(1, Inp$, "<a href=" & Chr$(34))
strLast = InStr(1, Inp$, Chr$(34) & ">")
strHTTP = InStr(1, Inp$, "http://")

If chrOpen Then
    If chrClose Then
        If phrHREF Then
            If strFirst Then
                If strLast Then
                ' Start retreiving URL
                    Inp$ = Mid$(Inp$, strHTTP)
                    GetURL$ = Mid(Inp$, 1, InStr(1, Inp$, Chr$(34)) - 1)
                ' End retreiving URL
                End If
            End If
        End If
    End If
End If

End Function