Extract all the links of a website

[stefanoste78]

I found this macro:

https://stackoverflow.com/questions/39222082/vba-to-find-text-from-webpages

I did not understand if it is possible to extract all the links of a web page or if it is possible to extract all the links of a website.

I would like to extract all the links of the pages of a website.

It could?

Thank you

 

[stefanoste78]

The email code:

Rem foglio 3
Private Sub CommandButton2_Click()
Dim htmldoc As Object, http, url$, loadok, col As Collection, i%, j%, laste%
laste = 4
Set htmldoc = CreateObject("htmlfile")
Set http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
For i = 4 To Me.Range("a" & Me.Rows.Count).End(xlUp).Row
    url = Me.Cells(i, 1)
    On Error Resume Next
    http.Open "GET", url, False
    http.send
    If Err.Number = 0 Then loadok = True
    On Error GoTo 0
    If loadok Then
        htmldoc.body.innerHTML = http.responseText
        Set col = GMAd(htmldoc)
        For j = 1 To col.Count
            Me.Cells(laste, 5) = col(j)
            laste = laste + 1
        Next
    End If
Next
End Sub

Function GMAd(ByVal hdoc As Object) As Collection
Dim opcol As Collection, emm As Object, mfound As Object, regEx As Object
Set opcol = New Collection
Set regEx = CreateObject("VBScript.RegExp")
With regEx
    .Pattern = "([a-zA-Z0-9_\-\.]+)@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.)|" & _
    "(([a-zA-Z0-9\-]+\.)+))([a-zA-Z]{2,4}|[0-9]{1,3})(\]?)"
    .Global = True
    Set emm = .Execute(hdoc.body.innerHTML)
End With
For Each mfound In emm
    On Error Resume Next
    opcol.Add mfound.Value, Key:=mfound.Value
    On Error GoTo 0
Next
Set GMAd = opcol
End Function

I'm trying to figure out how to put all these codes in the form and assign each one the start button.
It will take a bit 'of time
thanks for now

 

[Worf]

It is important that you try.
You will not always find people to prepare ready to use workbooks...

 

[stefanoste78]

It is important that you try.
You will not always find people to prepare ready to use workbooks...

Right