CODEWITHSUNDEEP
htmlexcelvbahtml-tableelement
Pmac
Pmac

Reputation: 21

HTML Table to Excel - Issue transform data into a table - Pasting all in one cell

I am having a problem converting a a class element into a table.

My code is copying the information but is pasting just into one cell and I would like to transform into a table identical as in the website.

Issue: Sheet1.Range("A1").Value = objIE.document.getElementsByClassName("niwa-table regionalIndices")(0).innerText

Thanks in advance.

My Code:

Sub ExtractLastValue()

Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")

objIE.Visible = True

objIE.navigate ("https://fireweather.niwa.co.nz/region/Otago")

Dim t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 8 '<==Adjust wait time

While objIE.Busy Or objIE.readyState < 4: DoEvents: Wend
t = Timer
Do
    DoEvents
    On Error Resume Next
    Set ele = objIE.document.getElementById("")
    If Timer - t > MAX_WAIT_SEC Then Exit Do
    On Error GoTo 0
Loop While ele Is Nothing

If Not ele Is Nothing Then
    'do something
End If
Sheet1.Range("A1").Value = objIE.document.getElementsByClassName("niwa-table regionalIndices")(0).innerText

End Sub

Result:

My Code:

Sub ExtractLastValue()

Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.Application")

objIE.Visible = True

objIE.navigate ("https://fireweather.niwa.co.nz/region/Otago")

Dim t As Date, ele As Object
Const MAX_WAIT_SEC As Long = 8 '<==Adjust wait time

While objIE.Busy Or objIE.readyState < 4: DoEvents: Wend
t = Timer
Do
    DoEvents
    On Error Resume Next
    Set ele = objIE.document.getElementById("")
    If Timer - t > MAX_WAIT_SEC Then Exit Do
    On Error GoTo 0
Loop While ele Is Nothing

If Not ele Is Nothing Then
    'do something
End If
Sheet1.Range("A1").Value = objIE.document.getElementsByClassName("niwa-table regionalIndices")(0).innerText

End Sub

Result:

Upvotes: 1

Views: 56

Answers (1)

TinMan
TinMan

Reputation: 7759

The easiest thing to do is to wrap table's html in a html tag, copy it to the clipboard and paste it to the target range.

Sub ExtractLastValue()

    Dim objIE As Object
    Set objIE = CreateObject("InternetExplorer.Application")

    objIE.Visible = True

    objIE.navigate ("https://fireweather.niwa.co.nz/region/Otago")

    Dim t As Date, ele As Object
    Const MAX_WAIT_SEC As Long = 8 '<==Adjust wait time

    While objIE.Busy Or objIE.readyState < 4: DoEvents: Wend
    t = Timer
    Do
        DoEvents
        On Error Resume Next
        Set ele = objIE.document.getElementById("")
        If Timer - t > MAX_WAIT_SEC Then Exit Do
        On Error GoTo 0
    Loop While ele Is Nothing

    If Not ele Is Nothing Then
        'do something
    End If

    Dim HTML As String
    HTML = "<html>" & objIE.document.getElementsByClassName("niwa-table regionalIndices")(0).outerHTML & "</html>"

    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' New DataObject
        .SetText HTML
        .PutInClipboard
    End With

    With Sheet1
        .Range("A1").PasteSpecial
        With .Range("A1").CurrentRegion
            .WrapText = False
            .Columns.AutoFit
        End With
    End With

End Sub

Result

Image Code Result

Upvotes: 1

Related Questions