Экспорт веб-текста в Excel VBS - PullRequest
0 голосов
/ 12 апреля 2020

Привет, все, что я искал в Интернете, как сумасшедший, и придумал следующий код VBA в Excel, проблема в том, что он экспортирует таблицу, а не текст в таблице, кажется, восстанавливает только весь текст в таблице, которую вы можете нажмите, но не любой заданный текст.

Если кому-то будет проще помочь с собственным кодом, делать то, что мне нужно, будет очень полезно.

Sub my_Procedure()
Dim htm As Object
Dim Tr As Object
Dim Td As Object
Dim Tab1 As Object

 Dim http As Object, html As New HTMLDocument
Dim paras As Object, para As Object, i As Long
Set http = CreateObject("MSXML2.XMLHTTP")
Set http = CreateObject("MSXML2.XMLHTTP")
http.Open "GET", "https://www.plus500.co.uk/?id=113082&tags=g_sr%2B1711614451_cpi%2BUKSearchBrand_cp%2B70887725030_agi%2BPlus500Core_agn%2Bplus%20500_ks%2Bkwd-842162906_tid%2Be_mt%2Bc_de%2Bg_nt%2B_ext%2B1006989_loc%2BUURL&%D7%90&gclid=CjwKCAjw1cX0BRBmEiwAy9tKHqylty6Mz9TbIA5VzgOiqxOcWg7biR652Hg9tksIR97hlUuAHLZilhoCTq0QAvD_BwE", False
http.send
html.body.innerHTML = http.responseText
Set paras = html.getElementsByTagName("Tbody")
i = 1
For Each para In paras
    ThisWorkbook.Worksheets("Sheet3").Cells(i, 1).Value = para.innerText
    i = i + 1
Next

Dim Doc As HTMLDocument
'Replace the URL of the webpage that you want to download
Web_URL = VBA.Trim(Sheets(1).Cells(1, 1))

'Create HTMLFile Object
Set HTML_Content = CreateObject("htmlfile")

Dim tdd As String
'Get the WebPage Content to HTMLFile Object
With CreateObject("msxml2.xmlhttp")
    .Open "GET", Web_URL, False
    .send
    HTML_Content.body.innerHTML = http.responseText
End With

Column_Num_To_Start = 1
iRow = 2
iCol = Column_Num_To_Start
iTable = 0

'Loop Through Each Table and Download it to Excel in Proper Format
For Each Tab1 In HTML_Content.getElementsByTagName("tbody")
    With HTML_Content.getElementsByTagName("tbody")(iTable)
        For Each Tr In .Rows
            For Each Td In Tr.Cells
             Sheets(1).Cells(iRow, iCol).Select
                Sheets(1).Cells(iRow, iCol) = Td.innerText
                iCol = iCol + 1
            Next Td
            iCol = Column_Num_To_Start
            iRow = iRow + 1
        Next Tr
    End With
    iTable = iTable + 1
    iCol = Column_Num_To_Start
    iRow = iRow + 1
Next Tab1

MsgBox "Process Completed"
Call StartTimer

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...