从Web下载文件(PDF)

时间:2013-03-26 16:01:50

标签: excel vba excel-vba download

我是VBA的新手。 如何使用来自http://cetatenie.just.ro/wp-content/uploads/的UrlDownloadToFile下载PDF文件?

有人可以帮忙吗?该代码正在搜索PDF文件udner超链接,并根据某些标准(即其名称下的当前年份)进行匹配。

Function UrlDownloadToFile(lNum As Long, sUrl As String, sPath As String, _
                           lNum1 As Long, lNum2 As Long) As Long

    UrlDownloadToFile = 0

    End Function

    Sub DownPDF()
    ' This macro downloads the pdf file from webpage
    ' Need to download MSXML2 and MSHTML parsers and install

    Dim sUrl As String
    Dim xHttp As MSXML2.XMLHTTP
    Dim hDoc As MSHTML.HTMLDocument
    Dim hAnchor As MSHTML.HTMLAnchorElement
    Dim Ret As Long
    Dim sPath As String
    Dim i As Long

    sPath = "C:\Documents and Settings\ee28118\Desktop\"
    sUrl = "http://cetatenie.just.ro/wp-content/uploads/"

    'Get the directory listing
    Set xHttp = New MSXML2.XMLHTTP
    xHttp.Open "GET", sUrl
    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
    For i = 0 To hDoc.getElementsByTagName("a").Length - 1
        Set hAnchor = hDoc.getElementsByTagName("a").Item(i)

        'test the pathname to see if it matches your pattern
        If hAnchor.pathname Like "Ordin-*.2013.pdf" Then
            Ret = UrlDownloadToFile(0, sUrl & hAnchor.pathname, sPath, 0, 0)

            If Ret = 0 Then
                Debug.Print sUrl & hAnchor.pathname & " downloaded to " & sPath
            Else
                Debug.Print sUrl & hAnchor.pathname & " not downloaded"
            End If
        End If
    Next i

    End Sub

1 个答案:

答案 0 :(得分:2)

抱歉 - 我应该猜到URLDownloadToFile是一个API调用,可以在SQL "%" equivalent in VBA回答整个问题。

完全删除名为URLDownloadToFile的函数。将其粘贴到模块程序

所在模块的顶部
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, _
    ByVal szURL As String, _
    ByVal szFileName As String, _
    ByVal dwReserved As Long, _
    ByVal lpfnCB As Long) As Long

现在将Sample中的一行更改为

Ret = URLDownloadToFile(0, sUrl & hAnchor.pathname, sPath & hAnchor.pathname, 0, 0)

然后你应该好好去。如果你想要一些不同的文件名,那么你必须编写一些逻辑来在每次迭代时改变它。