Невозможно распечатать весь результат в подпроцедуре, заполненной функцией - PullRequest
1 голос
/ 17 марта 2019

Я написал скрипт в 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 & "-" & oCom.innerText
        Next elem
    End With
End Function

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

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

1 Ответ

1 голос
/ 17 марта 2019

Не уверен, что вы подразумеваете под сохранить дизайн , поэтому возвращаем строку и диктуем (как объект) методы возврата

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 & "-" & 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 & oName.innerText & "-" & oCom.innerText & "###"
        Next elem
    End With
    getPOST = result
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...