Question

此主题与Loop through links and download PDF's

有关

我正在尝试将当前的VBA代码转换为VBScript。我已经了解到，我已经删除了变量类型（作为Dim语句的...一部分），并使用CreatObject来获取这些对象，但否则其他所有内容都应按原样移植。 DoEvents还必须替换为Wscript.sleep之类的东西。

我遇到了一些问题。当前，在运行VBS文件时，出现错误消息“需要对象：'MSHTML'”。指向第65行，这里有Set hDoc = MSHTML.HTMLDocument。我曾尝试在Google上进行搜索，但对此没有任何帮助。

我应该如何进行呢？

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 getName(pf)
    getName = Split(pf, "/")(UBound(Split(pf, "/")))
End Function

Answer 1

使用而不是Set hDoc = MSHTML.HTMLDocument，

Set hDoc = CreateObject("htmlfile")

在VBA / VB6中，可以指定变量和对象类型，但不能使用VBScript。您必须使用CreateObject（或GetObject：GetObject function）实例化MSHTML.HTMLDocument，Microsoft.XMLHTTP，InternetExplorer.Application等对象，而不是声明那些对象例如使用Dim objIE As InternetExplorer.Application。

另一个变化：

If Anchor.pathname Like "*.pdf" Then

可以使用StrComp function来写：

If StrComp(Right(Anchor.pathname, 4), ".pdf", vbTextCompare) = 0 Then

或使用InStr function：

If InStr(Anchor.pathname, ".pdf") > 0 Then

此外，在子标题的开头，请执行以下操作：

Set xHttp = CreateObject("Microsoft.XMLHTTP")
Dim xHttp

您应在分配变量值或对象之前声明它们。在VBScript中，此操作非常轻松，因为VBScript会为您创建未定义的变量，所以您的代码将起作用，但是在使用变量之前Dim是一个很好的做法。

除了Wscript.sleep命令之外，您的VBScript代码将在VB6 / VBA中运行，因此您可以在VB6或VBA应用程序（例如Excel）中调试脚本。

循环浏览网站链接并获取PDF至我的计算机

1 个答案: