循环访问网站链接并将 PDF 文件发送到我的电脑

Question

此主题与

相关

我正在尝试将当前的 VBA 代码转换为 VBScript。我已经明白我有 删除变量类型（作为 Dim 语句的一部分）并使用 CreatObject 获取这些对象，但除此之外一切都应该按原样移植。 DoEvents 也必须替换为 Wscript.sleep.

我遇到了一些问题。当前，在运行 VBS 文件时，我收到一条错误消息 "Object required: '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 文件发送到我的电脑

Loop through website links and get PDF's to my computer

vbscript

web-crawler

web-scraping