Links/urls uit html tekst halen

[jeroenb93]

Hoe kan ik links/urls uit de html text halen in cel A1. Zie screenshot



ik probeer nu met deze code

VBA code

Function LinksInText(ByVal InputText As String) As String
    Dim s() As String
    Dim i As Integer
    s = Split(InputText, Chr(34))
    For i = 1 To UBound(s) Step 2
        LinksInText = LinksInText & s(i) & ", "
    Next i
    LinksInText = Left(LinksInText, Len(LinksInText) - 2)
End Function

formule

=LinksInText(A2)

Alles wat dan tussen dubbele quotes, haalt hij eruit. Alleen soms ziet de a-tag er anders uit. Bijvoorbeeld:
<a href="url_for_output" name="example"></a> waardoor dus ook "example" eruit gehaald word. Zie voorbeeld hieronder



hoe kan ik dit oplossen?

 

[SjonR]

Welkom hier,

Plaats een voorbeeldbestand en het antwoord is er een stuk sneller dan zonder bestand. Met plaatjes is het lastig testen.

Gr.

Sjon

 

[jeroenb93]

Voorbeeld

Zie bijlage

 

[edmoor]

Probeer dit eens:

Function LinksInText(ByVal InputText As String) As String
    urls = Split(InputText, Chr(34))
    For i = 0 To UBound(urls)
        If Left(urls(i), 4) = "http" Then Url = Url & ", " & urls(i)
    Next i
    LinksInText = Mid(Url, 3)
End Function

 

[jeroenb93]

niet alles begint met http

Hallo bedankt, dit werkt idd. alleen niet alle urls beginnen met http. In dit voorbeeld idd wel. Kan je niet controleren op alles wat tussen de dubbele quotes staan na href=Chr(34)?

 

[edmoor]

Dan maak je er toch zoiets van ?

Function LinksInText(ByVal InputText As String) As String
    urls = Split(InputText, Chr(34))
    For i = 0 To UBound(urls)
        Select Case LCase(Left(urls(i), 3))
            Case "htt", "ftp": Url = Url & ", " & urls(i)
        End Select
    Next i
    LinksInText = Mid(Url, 3)
End Function

Of:

Function LinksInText(ByVal InputText As String) As String
    urls = Split(InputText, "href=")
    For i = 0 To UBound(urls)
        If Left(urls(i), 1) = Chr(34) Then Url = Url & ", " & Mid(urls(i), 2, InStr(2, urls(i), Chr(34)) - 2)
    Next i
    LinksInText = Mid(Url, 3)
End Function

Net wat je maar wil.

 

[jeroenb93]

Geweldig

Dat laatste heeft me geholpen. Je bent een held!!

Thx edmoor

 

[edmoor]

Mooi
Dan mag je je vraag nog even als opgelost aanmerken.