Блог

Я написал скрипт на vba для печати всего результата в рамках вспомогательной процедуры, PrintResult() заполненной getPOST() функцией. Моя текущая попытка печатает только последний результат проанализированного содержимого. Я знаю, что можно было бы сохранить результат в словаре, чтобы распечатать их все сразу, но не могу получить представление об этом конкретном использовании.

Важно сохранить существующий дизайн нетронутым.

Текущая попытка:

 Function getPOST() As String
    Const link$ = "https://admintool.noah-connect.com/widget/attendees"
    Dim Http As New XMLHTTP60, Html As New HTMLDocument
    Dim elem As Object, tRow As Object, oName As Object, oCom As Object

    With Http
        .Open "GET", link, False
        .send
        Html.body.innerHTML = .responseText
        For Each elem In Html.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
            Set oName = elem.getElementsByTagName("td")(0)
            Set oCom = elem.getElementsByTagName("td")(1)
            getPOST = oName.innerText amp; "-" amp; oCom.innerText
        Next elem
    End With
End Function

Sub PrintResult()
    Debug.Print getPOST()
End Sub
  

Как я могу напечатать весь результат внутри, PrintResult() заполненный getPOST() функцией?

Не уверен, что вы подразумеваете под сохранением дизайна, поэтому предоставляете методы возврата string и dict (как object)

 Option Explicit
Public Sub PrintResult()
    Dim dict As Object, key As Variant
    Set dict = getPOST
    For Each key In dict.keys
        Debug.Print dict(key)
    Next
End Sub

Public Function getPOST() As Object
    Const link$ = "https://admintool.noah-connect.com/widget/attendees"
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim elem As Object, tRow As Object, oName As Object, oCom As Object
    Dim i As Long, dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    With http
        .Open "GET", link, False
        .send
        html.body.innerHTML = .responseText
        For Each elem In html.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
            i = i   1
            Set oName = elem.getElementsByTagName("td")(0)
            Set oCom = elem.getElementsByTagName("td")(1)
            dict(i) = oName.innerText amp; "-" amp; oCom.innerText
        Next elem
    End With
    Set getPOST = dict
End Function
  

 Option Explicit
Public Sub PrintResult()
    Dim items() As String, result As String, i As Long
    result = getPOST
    items = Split(result, "###")
    For i = LBound(items) To UBound(items)
        Debug.Print items(i)
    Next
End Sub
Public Function getPOST() As String
    Const link$ = "https://admintool.noah-connect.com/widget/attendees"
    Dim http As New XMLHTTP60, html As New HTMLDocument
    Dim elem As Object, tRow As Object, oName As Object, oCom As Object, result As String
    result = ""
    With http
        .Open "GET", link, False
        .send
        html.body.innerHTML = .responseText
        For Each elem In html.getElementsByTagName("tbody")(0).getElementsByTagName("tr")
            Set oName = elem.getElementsByTagName("td")(0)
            Set oCom = elem.getElementsByTagName("td")(1)
            result = result amp; oName.innerText amp; "-" amp; oCom.innerText amp; "###"
        Next elem
    End With
    getPOST = result
End Function