如何使用 Excel VBA 从浏览器下载 pdf 文件
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/43038325/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How to download a pdf file from browser using Excel VBA
提问by Sona Shetty
I am using the below code snippet to download a PDF file from a website.
我正在使用以下代码片段从网站下载 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&docid=*8G0SU4Fcf)xcWWX6e96)FGlOL4rOYYt0i3m)HlGth2F(W4RnxurPClkHvNBurOAsaeNfGlwBKzzTm5&outputname=&FirstPage=1&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&docid=*8G0SU4Fcf)xcWWX6e96)FGlOL4rOYYt0i3m)HlGth2F(W4RnxurPClkHvNBurOAsaeNfGlwBKzzTm5&outputname=&pageno=1&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>
I have also tried the below method
我也试过下面的方法
Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
WHTTP.Open "GET", fileUrl, False
WHTTP.Send
FileData = WHTTP.ResponseBody
when i open the url given in the above code in browser,i can see pdf file getting opened automatically.How do i download the same pdf file opened in my browser using code?
当我在浏览器中打开上述代码中给出的 url 时，我可以看到 pdf 文件自动打开。如何使用代码下载在浏览器中打开的相同 pdf 文件？
Can some one help me to resolve the issue.
有人可以帮我解决这个问题。
回答by ASH
I can think of a couple ways to do this. If you want to loop through a bunch of links, and download all files, you can setup an inventory list in Excel, like you see in the image below.
我可以想到几种方法来做到这一点。如果您想遍历一堆链接并下载所有文件，您可以在 Excel 中设置一个清单，如下图所示。
Then, run the following Macro.
然后，运行以下宏。
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
Now, if you just want to download one single file, run the script below.
现在，如果您只想下载一个文件，请运行以下脚本。
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
