1

based this code i need to get also the link value from each row in table.

Actually i get only PR and PROVINCIA

reference link: https://www.comuniecitta.it/sigle-province-italiane

for example of first row i need:

AG AGRIGENTO https://www.comuniecitta.it/sicilia-19/provincia-di-agrigento-84

code:

Sub AGG_PROVINCE(ByVal MYURL As String)

    Dim oDom As Object, PR As String, PROVINCIA As String
    Set oDom = CreateObject("htmlFile")
    Dim X As Long, Y As Long
    Dim oRow As Object, oCell As Object
    Dim DATA() As String

    Y = 1
    X = 1

    With CreateObject("msxml2.xmlhttp")

        .Open "GET", MYURL, False
        .Send
        oDom.body.innerHtml = .responseText

        'Debug.Print .body.innerHtml

    End With

    With oDom.getElementsByTagName("table")(0)

        ReDim DATA(1 To .Rows.Length, 1 To .Rows(1).Cells.Length)

        For Each oRow In .Rows

            For Each oCell In oRow.Cells

                DATA(X, Y) = oCell.innerText

                Y = Y + 1

            Next oCell

            Y = 1
            X = X + 1

        Next oRow

    End With

    Dim intFile As Integer
    Dim strFile As String
    strFile = "C:\Lavori_Vb6\LEGGI_CSV_COMUNI\CSV\PROVINCE.csv"
    intFile = FreeFile
    Open strFile For Output As #intFile

    Dim K As Long
    For K = 1 To UBound(DATA)

        PR = UCase(DATA(K, 1))
        PROVINCIA = UCase(DATA(K, 2))
        
        Print #intFile, PR & ";" & PROVINCIA

    Next K

    Close #intFile

End Sub

other way are welcome? naturtally

StayOnTarget
  • 11,743
  • 10
  • 52
  • 81
user1579247
  • 107
  • 1
  • 6

1 Answers1

3

You can get the link itself from oCell.getElementsByTagName("a")(0).getAttribute("href") but obviously the link is only present in the cells in the 2nd column so you need to do something like this ... replace

DATA(X, Y) = oCell.innerText

... with ...

If oCell.getElementsByTagName("a").Length > 0 Then
    DATA(x, Y) = oCell.innerText & ", link: " & oCell.getElementsByTagName("a")(0).getAttribute("href")
Else
    DATA(x, Y) = oCell.innerText
End If

... which will append the link to the inner text (you might want to add it as a seperate item in your DATA array, or however you want to handle it?)

UPDATED CODE FOR COMMENT

Add this at the start of your Sub

Dim HLINK As String

Change your ReDim to

ReDim DATA(1 To .Rows.Length, 1 To .Rows(1).Cells.Length + 1)

Then replace the If with

DATA(x, Y) = oCell.innerText
If oCell.getElementsByTagName("a").Length > 0 Then
    DATA(x, Y + 1) = oCell.getElementsByTagName("a")(0).getAttribute("href")
Else
    DATA(x, Y) = oCell.innerText
End If

In the final For/Next, add

HLINK = UCase(DATA(K, 3))

And change the Print to

Debug.Print PR & ";" & PROVINCIA & ";" & HLINK
JohnM
  • 2,422
  • 2
  • 8
  • 20