2017-03-27 489 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 
相關問題