VBcoders Guest



Don't have an account yet? Register
 


Forgot Password?



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

by Nick Mancini (1 Submission)
Category: String Manipulation
Compatability: Visual Basic 4.0 (32-bit)
Difficulty: Unknown Difficulty
Originally Published: Fri 6th August 1999
Date Added: Mon 8th February 2021
Rating: (1 Votes)

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.



'   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


Download this snippet    Add to My Saved Code

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

No comments have been posted about These functions will extract an email address and url from given text.. Why not be the first to post a comment about These functions will extract an email address and url from given text..

Post your comment

Subject:
Message:
0/1000 characters