У меня есть код, который был здесь некоторое время с различными типами вопросов. Это приближается к окончательному варианту. Однако теперь у меня проблема с тем, что в коде есть ошибка, и часть ее не работает правильно.
Идея состоит в том, чтобы пройти по ссылкам и захватить PDF-файлы. Ссылки хранятся в sLinks, см. Строку с комментарием «Убедитесь, что ссылки хранятся в sLinks». Код идет вперед, и файлы сохраняются в C:\temp\, но после того, как в папке находятся 12 PDF, я получаю сообщение об ошибке, и отладчик указывает на xHttp.Open "GET", sLink.
Я просмотрел PDF-файлы, и похоже, что все они загружены ... поскольку некоторые из них одинаковы на нескольких страницах, а также имеется один PDF-файл политики на двух страницах как минимум. Вот почему есть 17 ссылок и 12 файлов. В любом случае, почему выдает ошибку?
В чем может быть проблема?
Вот мой код:
Sub DownloadFiles()
Dim xHttp As Object: Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim hDoc As MSHTML.HTMLDocument
Dim Anchors As Object
Dim Anchor As Variant
Dim sPath As String
Dim wholeURL As String
Dim internet As InternetExplorer
Dim internetdata As HTMLDocument
Dim internetlink As Object
Dim internetinnerlink As Object
Dim arrLinks As Variant
Dim sLink As String
Dim iLinkCount As Integer
Dim iCounter As Integer
Dim sLinks As String
Set internet = CreateObject("InternetExplorer.Application")
internet.Visible = False
internet.navigate ("https://www.nordicwater.com/products/waste-water/")
Do While internet.Busy
DoEvents
Loop
Do Until internet.readyState = READYSTATE_COMPLETE
DoEvents
Loop
Set internetdata = internet.document
Set internetlink = internetdata.getElementsByTagName("a")
i = 1
For Each internetinnerlink In internetlink
If Left$(internetinnerlink, 36) = "https://www.nordicwater.com/product/" Then
sLinks = sLinks & internetinnerlink.href & vbCrLf
i = i + 1
Else
End If
ThisWorkbook.Worksheets("Sheet1").range("B1").Value = sLinks ' Check that links are stored in sLinks
Next internetinnerlink
wholeURL = "https://www.nordicwater.com/"
sPath = "C:\temp\"
arrLinks = Split(sLinks, vbCrLf)
iLinkCount = UBound(arrLinks) + 1
For iCounter = 1 To iLinkCount
sLink = arrLinks(iCounter - 1)
'Get the directory listing
xHttp.Open "GET", sLink ' DEBUGGER IS POINTING HERE
xHttp.send
'Wait for the page to load
Do Until xHttp.readyState = 4
DoEvents
Loop
'Put the page in an HTML document
Set hDoc = New MSHTML.HTMLDocument
hDoc.body.innerHTML = xHttp.responseText
'Loop through the hyperlinks on the directory listing
Set Anchors = hDoc.getElementsByTagName("a")
For Each Anchor In Anchors
'test the pathname to see if it matches your pattern
If Anchor.pathname Like "*.pdf" Then
xHttp.Open "GET", wholeURL & Anchor.pathname, False
xHttp.send
With CreateObject("Adodb.Stream")
.Type = 1
.Open
.write xHttp.responseBody
.SaveToFile sPath & getName(wholeURL & Anchor.pathname), 2 '//overwrite
End With
End If
Next
Next
End Sub
Функция для создания имени файла из ссылки:
Function getName(pf As String) As String
getName = Split(pf, "/")(UBound(Split(pf, "/")))
End Function
РЕДАКТИРОВАТЬ:
Я исправил первую проблему. arrLinks = Split(p_sLinks, vbCrLf) изменено на arrLinks = Split(sLinks, vbCrLf), как и должно быть. Теперь я столкнулся с другой проблемой.