How to extract HTML source code to excel VBA

Question

I', trying to copy and paste the whole HTML body to excel worksheet. For now i have this

Sub audycje()

Dim strona As Object
Dim adres As String
Dim wb As Workbook
Dim a As String

Set strona = CreateObject("InternetExplorer.Application")
Set wb = ThisWorkbook

adres = InputBox("Podaj adres strony")

strona.navigate (adres)
wb.Worksheets("Dane").Range("B2") = strona.body.innerHTML
strona.Quit
    End Sub 

Just cant get the HTML to be inserted into excel ;/

[EDIT] I got this and it's working ok but...

Sub audycje()

Dim strona As Object
Dim adres As String
Dim wb As Workbook
Dim a As Object

Set strona = CreateObject("InternetExplorer.Application")
Set wb = ThisWorkbook
adres = InputBox("Podaj adres strony")
If adres = "" Then
MsgBox ("Nie podano strony do za?adowania")
Exit Sub
End If
strona.Visible = True
strona.navigate (adres)
wb.Worksheets("Dane").Range("B2") = strona.document.body.innerHTML
    End Sub

The whole HTML body is in one cell. How to spread it ?

question from:https://stackoverflow.com/questions/65832333/how-to-extract-html-source-code-to-excel-vba

Answer 1

Did you mean something like this?

    Sub audycje()
    
    Dim strona As Object
    Dim adres As String
    Dim wb As Workbook
    Dim a As Object
    Dim str_var As Variant
    
    Set strona = CreateObject("InternetExplorer.Application")
    Set wb = ThisWorkbook
    adres = InputBox("Podaj adres strony")
    If adres = "" Then
       MsgBox ("Nie podano strony do zaladowania")
    Exit Sub
    End If
    
    Set strona = CreateObject("htmlfile")   'Create HTMLFile Object
    With CreateObject("msxml2.xmlhttp")  'Get the WebPage Content
       .Open "GET", adres, False
       .send
       strona.Body.Innerhtml = .responseText
    End With
    
    'Split_with_delimiter_newline
    split_var = Split(strona.Body.Innerhtml, Chr(10))
    
    Application.ScreenUpdating = False
    
    For i = 0 To UBound(split_var, 1)
       Cells(2 + i, 2).Value2 = split_var(i)
    Next i
    
    Application.ScreenUpdating = True
    
    End Sub