Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Получить атрибут "href" / 8 сообщений из 8, страница 1 из 1
09.10.2017, 09:32
    #39533196
maxim863
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
Есть программа , которая работает отлично .Результат ее работы –вывод в 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") . Но в результате программа ничего не выдала . Наверное из-за того что внутри элемента есть еще один тег (“а”).
Затем я изменил ту же строку на data(x, y) = oRow.Cells(y). getelementsbytagname("a"). getAttribute("href"). И получил ошибку Run-time error ‘438’ : Object doesn’t support this property or method .
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
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
...
Рейтинг: 0 / 0
09.10.2017, 09:58
    #39533217
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
maxim863на data(x, y) = oRow.Cells(y). getelementsbytagname("a"). getAttribute("href"). И получил ошибку Run-time error ‘438’ : Object doesn’t support this property or method .Глубоко не вникая
само название getelementsbytagname говорит о том, что возвращается массив, стало быть нужно сделать цикл по результату
...
Рейтинг: 0 / 0
09.10.2017, 10:07
    #39533223
maxim863
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
Shocker.Pro, Если элемент один ,тогда пишем getelementsbytagname("a")(0) и получаем ошибку Run-time error '91' Object variable or With block variable not set
...
Рейтинг: 0 / 0
09.10.2017, 13:07
    #39533364
iMrTidy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
maxim863,

Сложно гадать, что так за файл, давайте ссылку или пример html файла.

Вызов oRow.Cells(y). getelementsbytagname("a")(0) приводит к ошибке?
...
Рейтинг: 0 / 0
09.10.2017, 13:43
    #39533394
maxim863
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
iMrTidy, да (Run-time error '91')
...
Рейтинг: 0 / 0
09.10.2017, 13:45
    #39533398
maxim863
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
...
Рейтинг: 0 / 0
09.10.2017, 15:58
    #39533513
iMrTidy
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
maxim863,

Тут проблема в том, что некоторые элементы не содержат child, а, например, только дату, в таком случае код и жалуется, что объекта нет. Вот так работает:

Код: vbnet
1.
2.
3.
4.
            If oRow.Cells(y).Children.Length > 0 Then
                'data(x, y) = oRow.Cells(y).innerHTML
                data(x, y) = oRow.Cells(y).getelementsbytagname("a")(0).getattribute("href")
            End If
...
Рейтинг: 0 / 0
10.10.2017, 08:45
    #39533809
maxim863
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Получить атрибут "href"
iMrTidy, Заработало ! Большое спасибо !
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Получить атрибут "href" / 8 сообщений из 8, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]