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

问题描述 投票：0回答：2

我正在使用下面的代码片段从网站下载 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 文件自动打开。如何使用代码下载在浏览器中打开的相同 pdf 文件？

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

vba excel dom
2个回答
2
投票

我可以想出几种方法来做到这一点。 如果您想循环浏览一堆链接并下载所有文件，您可以在 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
0
投票

公共子 HTMLfileSavePDF()

Dim https As Object
Dim objfso As Object
Dim objADOStream As Object
Dim url As String
Dim path As String
Dim strValue As String
    
url = InputBox("Укажите ссылку на страницу с документом", "Адрес документа(URL)")
If url = "" Then
   MsgBox "Не указана ссылка на станицу сайта с документом.", vbExclamation, "Не указан адрес документа(URL)"
   url = InputBox("Укажите ссылку на страницу с документом", "Адрес документа(URL)")
   If CancelInputBox = False Then
   Exit Sub
   End If
End If

出错时转到 errndl

Set https = CreateObject("MSXML2.serverXMLHTTP")
https.Open "GET", url, False
https.Send
HttpStatusCode = https.Status

strValue = "Код: " & HttpStatusCode & " - " & HttpStatusCodeTranslator(HttpStatusCode)  'Ошибки сайта

If https.Status = 200 Then
  Set objADOStream = CreateObject("ADODB.Stream")
  objADOStream.Open
  objADOStream.Type = 1 

  objADOStream.Write https.responsebody
  objADOStream.Position = 0   
  
 path = Application.GetSaveAsFilename(InitialFileName:="myPDFfile", _
    fileFilter:="PDF Files (*.pdf), *.pdf", Title:="Выбор папки для сохранения файла")
    If path = "" Then
        path = ThisWorkbook.path & "\myPDFfile.pdf"
        
    End If

  Set objfso = CreateObject("Scripting.FileSystemObject")
    If objfso.fileexists(path) Then objfso.DeleteFile path
  Set objfso = Nothing

  objADOStream.SaveToFile path
  MsgBox "PDF документ успешно сохранен!" & vbNewLine & "Путь к файлу:" & path, vbInformation, "Документ сохранен"
              'Обнуление объектов.
  objADOStream.Close
  Set objADOStream = Nothing
  Set https = Nothing
Else

 MsgBox "PDF документа не найден!" & vbNewLine & "Ошибка сайта: " & strValue, _
 vbCritical, "Ошибка сайта"
                'Обнуление объектов.
      objADOStream.Close
      Set objADOStream = Nothing
      Set https = Nothing
End If

退出子目录

errndl： 如果 Err.Description 像“安全设置阻止”那么 MsgBox "Ошибка требований безопасности компьютера. Проверьте доступ и повторите попытку", vbCritical, "Ошибка доступа" Else: MsgBox "Произошла следующая ошибка: " & Err.Description, vbCritical, "Ошибка подключения" 结束如果 'Обнуление объектов。 objADOStream.关闭 设置 objADOStream = 无 设置 https = 无 结束子 函数 HttpStatusCodeTranslator(ByVal HttpStatusCode As Long) As String

选择案例 HttpStatusCode 案例100 HttpStatusCodeTranslator = "Продолжить" 案例101 HttpStatusCodeTranslator = "Переключение протоколов" 案例200 HttpStatusCodeTranslator =“ОК” 案例201 HttpStatusCodeTranslator = "Создано" 案例202 HttpStatusCodeTranslator = "Принято" 案例203 HttpStatusCodeTranslator = "Недостоверная информация" 案例204 HttpStatusCodeTranslator = "Нет контента" 案例205 HttpStatusCodeTranslator = "Сброс контента" 案例206 HttpStatusCodeTranslator = "Частичное содержимое" 案例300 HttpStatusCodeTranslator = "Несколько вариантов выбора" 案例301 HttpStatusCodeTranslator = "Перемещено навсегда" 案例302 HttpStatusCodeTranslator = "Найдено" 案例303 HttpStatusCodeTranslator = "Смотрите другое" 案例304 HttpStatusCodeTranslator = "Не изменено" 案例305 HttpStatusCodeTranslator = "Используется прокси-сервер" 案例307 HttpStatusCodeTranslator = "Временное перенаправление" 案例400 HttpStatusCodeTranslator = "Неверный запрос" 案例401 HttpStatusCodeTranslator = "Неавторизованный запрос" 案例402 HttpStatusCodeTranslator = "Требуется оплата" 案例403 HttpStatusCodeTranslator = "Запрещено" 案例404 HttpStatusCodeTranslator = "Не найдено" 案例405 HttpStatusCodeTranslator = "Метод запрещен" 案例406 HttpStatusCodeTranslator = "Неприемлемо" 案例407 HttpStatusCodeTranslator = "Требуется аутентификация через прокси" 案例408 HttpStatusCodeTranslator = "Время ожидания запроса" 案例409 HttpStatusCodeTranslator =“Конфликт” 案例410 HttpStatusCodeTranslator = "Прервано" 案例411 HttpStatusCodeTranslator =“Требуется больше времени” 案例412 HttpStatusCodeTranslator = "Предварительное условие не выполнено" 案例413 HttpStatusCodeTranslator = "Слишком большая сущность запроса" 案例 414 HttpStatusCodeTranslator = "Слишком длинный URI запроса" 案例415 HttpStatusCodeTranslator = "Неподдерживаемый тип носителя" 案例 416 HttpStatusCodeTranslator = "Запрашиваемый диапазон не подходит" 案例417 HttpStatusCodeTranslator = "Ожидание не выполнено" 案例500 HttpStatusCodeTranslator = "Внутренняя ошибка сервера" 案例501 HttpStatusCodeTranslator = "Не реализовано" 案例502 HttpStatusCodeTranslator = "Плохой шлюз" 案例503 HttpStatusCodeTranslator = "Услуга недоступна" 案例504 HttpStatusCodeTranslator = "Тайм-аут шлюза" 案例505 HttpStatusCodeTranslator = "Версия HTTP не поддерживается" 其他情况 HttpStatusCodeTranslator = "Неизвестный код статуса" 结束选择

结束功能

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.