vbavb6vba6

GET value from web table


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


Solution

  • 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