This topic is related to Loop through links and download PDF's
I am trying to convert my current VBA code into VBScript. I have already understood that I have to remove the variable types (As ... part of Dim statements) and use CreatObject to get those objects but otherwise everything should port as-is. DoEvents will also have to be replaced with something like Wscript.sleep.
I came up with some problems. Currently while running VBS file I am getting an error saying "Object required: 'MSHTML'". Pointing to line 65, where I have Set hDoc = MSHTML.HTMLDocument
. I have tried to search on Google but got nothing helpful for this one.
How I should proceed with this one?
DownloadFiles("https://www.nordicwater.com/products/waste-water/")
Sub DownloadFiles(p_sURL)
Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim xHttp
Dim hDoc
Dim Anchors
Dim Anchor
Dim sPath
Dim wholeURL
Dim internet
Dim internetdata
Dim internetlink
Dim internetinnerlink
Dim arrLinks
Dim sLink
Dim iLinkCount
Dim iCounter
Dim sLinks
Set internet = CreateObject("InternetExplorer.Application")
internet.Visible = False
internet.navigate (p_sURL)
Do Until internet.ReadyState = 4
Wscript.Sleep 100
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
If sLinks <> "" Then sLinks = sLinks & vbCrLf
sLinks = sLinks & internetinnerlink.href
i = i + 1
Else
End If
Next
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
xHttp.send
'Wait for the page to load
Do Until xHttp.ReadyState = 4
Wscript.Sleep 100
Loop
'Put the page in an HTML document
Set hDoc = 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:
Function getName(pf)
getName = Split(pf, "/")(UBound(Split(pf, "/")))
End Function