2017-03-27 436 views
3

我使用下面的代码片段从网站下载PDF文件。如何使用Excel VBA从浏览器下载PDF文件

Option Explicit 

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 

Sub Test() 
    Dim strPDFLink As String 
    Dim strPDFFile As String 
    Dim Result As Boolean 
    strPDFLink = "myurl?SessionKey=rCpZeX9UP300002D50BA& docid=*8G0leLEfTTX3oX8QpVUmKqRoTj6zS6bzTWf9%29Dt1hij3ym9hKqucLhtOnWVeCgM0wyGJyjI9RNj3Kv&PageNo=1" 
    strPDFFile = "D:\Users\d828737\Desktop\Doc Comparison\Temp\abcd.pdf" 
    Result = DownloadFile(strPDFLink, strPDFFile) 
End Sub 

Function DownloadFile(URL As String, LocalFilename As String) As Boolean 
    Dim lngRetVal As Long 
    lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0) 
    If lngRetVal = 0 Then DownloadFile = True 
End Function 

Below is the response i am getting from browser using code 
    <html> 
    <head> 
    <META http-equiv="Content-Type" content="text/html; charset=UTF-8"> 
    <title>Interview Enterprise Web Client</title> 
    </head> 
    <frameset name="ImageFrame" border="1" framespacing="0" topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" rows="*,80"> 
    <frame name="document" src="iv_web_client.iv_document?SessionKey=1aYT4sGK1200002D50C6&amp;docid=*8G0SU4Fcf)xcWWX6e96)FGlOL4rOYYt0i3m)HlGth2F(W4RnxurPClkHvNBurOAsaeNfGlwBKzzTm5&amp;outputname=&amp;FirstPage=1&amp;options=" scrolling="auto" border="0" frameborder="no" topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" style="border-bottom:solid#000000 1px;" noresize=""> 
    <frame name="control" src="iv_web_client.iv_doc_sel?SessionKey=1aYT4sGK1200002D50C6&amp;docid=*8G0SU4Fcf)xcWWX6e96)FGlOL4rOYYt0i3m)HlGth2F(W4RnxurPClkHvNBurOAsaeNfGlwBKzzTm5&amp;outputname=&amp;pageno=1&amp;options=" scrolling="auto" border="0" frameborder="no" topmargin="0" leftmargin="0" marginheight="0" marginwidth="0" style="border-bottom:solid#000000 1px;" noresize=""> 
    </frameset> 
    <noframes>You need a frames capable browser to use this site.</noframes> 
</html> 

我也曾尝试以下方法

Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1") 
WHTTP.Open "GET", fileUrl, False 
WHTTP.Send 
FileData = WHTTP.ResponseBody 

当我打开浏览器上面的代码中给出的网址,我可以看到PDF文件打开越来越不automatically.How我下载相同的PDF文件在我的浏览器中使用代码打开?

有人可以帮我解决这个问题。

+0

如果删除abcd.pdf,会发生什么情况?并运行它给名称 – 0m3r

+0

仍然我得到相同的错误 –

+0

'strPDFLink'是那个本地链接? - – 0m3r

回答

0

我可以想到一些方法来做到这一点。如果您想循环访问一系列链接并下载所有文件,则可以在Excel中设置清单列表,如下图所示。

enter image description here

然后,运行以下宏。

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 

Sub DownloadFilefromWeb() 
    Dim strSavePath As String 
    Dim URL As String, ext As String 
    Dim buf, ret As Long 
    URL = Worksheets("Sheet1").Range("A2").Value 
    buf = Split(URL, ".") 
    ext = buf(UBound(buf)) 
    strSavePath = "C:\Users\rshuell\Desktop\Downloads\" & "DownloadedFile." & ext 
    ret = URLDownloadToFile(0, URL, strSavePath, 0, 0) 
    If ret = 0 Then 
     MsgBox "Download has been succeed!" 
    Else 
     MsgBox "Error" 
    End If 
End Sub 

现在,如果您只想下载单个文件,请运行以下脚本。

Sub DownloadFileWithVBA() 

Dim myURL As String 
'Right-click on the link named 'Sample Address File' 
'Click 'Copy Link Location' 
'Paste the link below 
myURL = "http://databases.about.com/library/samples/address.xls" 

Dim WinHttpReq As Object 
Set WinHttpReq = CreateObject("Microsoft.XMLHTTP") 
WinHttpReq.Open "GET", myURL, False 
WinHttpReq.Send 

myURL = WinHttpReq.ResponseBody 
    Set oStream = CreateObject("ADODB.Stream") 
    oStream.Open 
    oStream.Type = 1 
    oStream.Write WinHttpReq.ResponseBody 
    oStream.SaveToFile ("C:\Users\Excel\Desktop\address.xls") 
    oStream.Close 

End Sub 
相关问题