Question

有一个程序可以正常工作。她工作的结果是元素表中Excel的输出（每个元素看起来像“{td class=clr width=69>{a class=bluelink href=main.php?champ=2604&f_date=201611&tour=110}06.11.2016{/a}{/td}”）。我试图转换一个程序，以便输出每个元素的href（“main.php?champ=2604&f_date=201611&tour=110”）。我将行data(x, y) = oRow.Cells(y).innerHTML更改为data(x, y) = oRow.Cells(y). getAttribute("href")。但结果是，该计划没有给出任何东西。可能是因为元素内部还有一个标签（“a”）。然后我将同一行更改为data(x, y) = oRow.Cells(y). getelementsbytagname("a"). getAttribute("href")。

出现错误（运行时错误'438'：对象不支持此操作财产或方法）。

    Function extractTable(Ssilka As String, book1 As Workbook, iLoop As Long)
    Dim oDom As Object, oTable As Object, oRow As Object
    Dim iRows As Integer, iCols As Integer
    Dim x As Integer, y As Integer
    Dim data()
    Dim oHttp As Object
    Dim oRegEx As Object
    Dim sResponse As String
    Dim oRange As Range



    ' get page
    Set oHttp = CreateObject("MSXML2.XMLHTTP")
    oHttp.Open "GET", Ssilka, False
    oHttp.Send

    ' cleanup response
    sResponse = StrConv(oHttp.responseBody, vbUnicode)
    Set oHttp = Nothing

    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))

    Set oRegEx = CreateObject("vbscript.regexp")
    With oRegEx
    .MultiLine = True
    .Global = True
    .IgnoreCase = False
    .Pattern = "<(script|SCRIPT)[\w\W]+?</\1>"
    sResponse = .Replace(sResponse, "")
    End With
    Set oRegEx = Nothing

    ' create Document from response
    Set oDom = CreateObject("htmlFile")
    oDom.Write sResponse
    DoEvents

    ' table with results, indexes starts with zero
    Set oTable = oDom.getelementsbytagname("table")(3)

     DoEvents

    iRows = oTable.Rows.Length
    iCols = oTable.Rows(1).Cells.Length

   ' first row and first column contain no intresting data
     ReDim data(1 To iRows - 1, 1 To iCols - 1)

    ' fill in data array
    For x = 1 To iRows - 1
       Set oRow = oTable.Rows(x)

       For y = 1 To iCols - 1
          data(x, y) = oRow.Cells(y).innerHTML

 '<td class=clr width=69><a class=bluelink href=main.php?
 champ=2604&f_date=201611&tour=110>06.11.2016</a></td>
 'getAttribute("href")
 'td-table data ячейка таблицы

    Next y
    Next x

    Set oRow = Nothing
    Set oTable = Nothing
    Set oDom = Nothing


   ' put data array on worksheet

     Set oRange = book1.ActiveSheet.Cells(34, iLoop * 25).Resize(iRows - 1, iCols - 1)
    oRange.NumberFormat = "@"
    oRange.Value = data

    Set oRange = Nothing


   '<DEBUG>
   '    For x = LBound(data) To UBound(data)
   '        Debug.Print x & ":[ ";
   '        For y = LBound(data, 2) To UBound(data, 2)
   '            Debug.Print y & ":[" & data(x, y) & "] ";
   '        Next y
   '        Debug.Print "]"
   '    Next x
   '</DEBUG>



    End Function

获取href属性

0 个答案: