Попытка очистить веб-данные от URL использует фрейм. Получить данные в MSHTML.HTMLDocument obect. Я хочу сохранить объект как .xls на жестком диске - PullRequest
0 голосов
/ 22 января 2019

Я хочу очистить данные от URL. Я использую VBA в Excel. Я могу получить данные в объекте MSHTML.HTMLDocument iframeDoc. Теперь я хочу сохранить данные в объекте iframeDoc в виде файла Excel на жестком диске. Ни одно из свойств, таких как iframeDoc.Documentelent.innerHTML, не работает. Оно выдает ошибку во время выполнения. Объект не поддерживает свойство. Поэтому мне нужна помощь, чтобы преобразовать объект в строковый тип или любой другой метод для сохранения на жесткий диск. Спасибо.

Я пробовал свойства MSHTML.HTMLDocument DocumentElemnt и Body для сохранения в строку. Те дают ошибку времени выполнения.

 Sub

    Dim ie As SHDocVw.InternetExplorer

    Dim doc As MSHTML.HTMLDocument

    Dim url As String

url = "http://www.1line.williams.com/Transco/info-postings/notices/critical-notices.html"
Set ie = New SHDocVw.InternetExplorer
ie.Visible = True
ie.navigate url

While ie.Busy Or ie.readyState <> READYSTATE_COMPLETE
    DoEvents
Wend

Set doc = ie.document

Dim iframeDoc As MSHTML.HTMLDocument
Set iframeDoc = doc.frames.Item("theiframe")

If iframeDoc Is Nothing Then
    MsgBox "IFrame with name 'iframename' was not found."
    ie.Quit
    Exit Sub
Else
'*** to save iframeDoc object as .xls file on hard disc ***

Dim strframe As String
   strframe = CStr(iframeDoc.DocumentElement.innerHTML) ' Run time error 
    'object does not support the property or method
   End If
  End Sub   

Я ожидаю, что iframedoc.DocumentElement.innerHTML будет преобразован в строку. Но это дает объекту ошибки времени выполнения, не поддерживающему свойство или метод.

1 Ответ

0 голосов
/ 22 января 2019

Вам необходимо выделить достаточно времени для запуска javascript и заполнения таблицы внутри iframe. Я использовал синхронизированный цикл для этого

Option Explicit
Public Sub GetInfo()
    Dim ie As InternetExplorer, ws As Worksheet
    Dim hTable As HTMLTable, t As Date
    Const MAX_WAIT_SEC As Long = 10              '<==Adjust wait time
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set ie = New InternetExplorer

    With ie
        .Visible = True
        .Navigate2 "http://www.1line.williams.com/Transco/info-postings/notices/critical-notices.html"

        While .Busy Or .readyState < 4: DoEvents: Wend
        t = Timer
        Do
            On Error Resume Next
            With .document.getElementById("theiframe").contentDocument.getElementById("j_idt11")
                Set hTable = .getElementsByTagName("table")(1)
            End With
            On Error GoTo 0
            If Timer - t > MAX_WAIT_SEC Then Exit Do
        Loop While hTable Is Nothing
        If Not hTable Is Nothing Then
            WriteTable hTable, 1, ws
        End If
        .Quit
    End With
End Sub

Public Sub WriteTable(ByVal hTable As HTMLTable, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tRow As Object, td As Object, r As Long, c As Long
    r = startRow
    With ws
        Dim headers As Object, header As Object, columnCounter As Long
        Set headers = hTable.getElementsByTagName("th")
        For Each header In headers
            columnCounter = columnCounter + 1
            .Cells(r, columnCounter) = header.innerText
        Next header
        For Each tRow In hTable.getElementsByTagName("tr")
            r = r + 1: c = 1
            For Each td In tRow.getElementsByTagName("td")
                If td.classname = "ui-col-7" Then  'or you could use if c = 7
                    .Cells(r, c).Value = "http://www.1line.williams.com" & Replace$(Split(Split(td.outerhtml, "href=" & Chr$(34))(1), ">")(0), Chr$(34), vbNullString)
                Else
                    .Cells(r, c).Value = td.innerText
                End If
                c = c + 1
            Next td
        Next tRow
    End With
End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...