Я хочу обновить старый скрипт 2012 года. Однажды он извлечет данные таблицы из этого каталога и поместит в электронную таблицу.Я ржавею с моим VBA
Чего я не могу достичь, так это организованного стола в превосходстве онлайн-стола.В рамках передачи я нацеливаюсь на ссылку на синей кнопке DETAIL, поскольку в ней есть cID =, который затем мы будем перебирать на этих страницах для получения дополнительной информации о другом нижнем индексе (потому что я недостаточно продвинут, чтобы сделать все это за один раз илихочу обложить налогом их сервер):
javascript: CompanyDetails ('http://www.loadmatch.com/popup/company_detail.cfm?referer=Drayage.com&cID=3435&m=BIR&code=BIR'
Вот источник https://pastebin.com/mj7tDgqn, с веб-сайта одного из многочисленных городов (этоБирмингем, есть 102 городских страницы и более 1000 провайдеров внутри)
Вот полный код VBA, который я сделал https://pastebin.com/NHBVH29u
Я чувствую, что что-то не так в этом подпункте ниже GetOneTable,который вызывается к действию из другого подпрограммы, как только мы попадаем на правильную страницу. Он извлекает информацию, хотя и не в правильном месте, и не все данные таблицы. Кажется, только последняя строка.
Sub GetOneTable(d, n, z)' n is the table to extract
Dim e As Object ' the elements of the document
Dim t As Object ' the table required
Dim r As Object ' the rows of the table
Dim c As Object ' the cells of the rows.
Dim I As Long
Dim J As Long
On Error Resume Next
Sheets("Target").Select
For Each e In d.all
If e.nodename = "TABLE" Then
J = J + 1
End If
If J = n Then
Set t = e
tabno = tabno + 1
nextrow = nextrow + 1
Set Rng = Range("t" & z)
For Each r In t.Rows
For Each c In r.Cells
Rng.Value = c.innerhtml
Set Rng = Rng.Offset(, 1)
I = I + 1
Next c
Set Rng = Rng.Offset(, -I)
I = 0
Next r
Exit For
Cells.WrapText = False
End If
Next e
nextrow = nextrow + 1
On Error GoTo 0
End Sub