如何使用Excel VBA从浏览器下载pdf文件_Vba_Excel_Dom

如何使用Excel VBA从浏览器下载pdf文件

vba excel dom

如何使用Excel VBA从浏览器下载pdf文件,vba,excel,dom,Vba,Excel,Dom,我正在使用下面的代码片段从网站下载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, _

我正在使用下面的代码片段从网站下载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>

当我在浏览器中打开上述代码中给出的url时，我可以看到pdf文件自动打开。如何使用代码下载在浏览器中打开的相同pdf文件

谁能帮我解决这个问题。

我可以想出几种方法来解决这个问题。如果要循环浏览一组链接并下载所有文件，可以在Excel中设置清单列表，如下图所示

然后，运行以下宏

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

如果删除abcd.pdf，会发生什么情况？然后使用给定的名称运行它，直到得到相同的错误。

strPDFLink

是本地链接吗-

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