VBA Macro для загрузки нескольких файлов из ссылок в IE

Я хочу загрузить несколько файлов из списка ссылок. Веб-сайт, на котором я нахожу ссылки, защищен. Вот почему я хочу использовать IE (используя текущий сеанс/файл cookie). Цель каждой ссылки - xml-файл. Файлы слишком большие, чтобы открыть, а затем сохранить. Поэтому мне нужно сохранить их напрямую (щелкните правой кнопкой мыши, сохраните цель как).VBA Macro для загрузки нескольких файлов из ссылок в IE

Список ссылок выглядит следующим образом:

<html> 
<body> 
<p> <a href="https://example.com/report?_hhhh=XML"Link A</a><br>> </p> 
<p> <a href="https://example.com/report?_aaaa=XML"Link B</a><br>> </p> 
... 
</body> 
</html>

Я хочу, чтобы перебрать все ссылки и сохранить каждую цель. В настоящее время у меня проблемы с «Сохранить как». Я не знаю, как это сделать. Это мой код:

Sub DownloadAllLinks() 

Dim IE As Object 
Dim Document As Object 
Dim List As Object 
Dim Link As Object 

' Before I logged in to the website 
Set IE = CreateObject("InternetExplorer.Application") 
IE.Visible = True 
IE.Navigate ("https:\\......\links.html") 

Do While IE.Busy 
    DoEvents 
Loop 

' Detect all links on website 
Set Document = IE.Document 
Set List = Document.getElementsByTagName("a") 

' Loop through all links to download them 

For Each Link In List 

' Now I need to automate "save target as"/right-click and then "save as" 
... 

Next Link 
End Sub

У вас есть идеи автоматизировать «Сохранить как» для каждой ссылки?

Любая помощь приветствуется. Большое спасибо, Ули

источник

2015-09-26 Uli

Это кроличья дыра, которую я несколько раз спасал. Короткий ответ - перестать пытаться заставить IE действовать как агент для загрузки файлов. Используйте объект xmlHttp для входа и получения/возврата аутентификации с помощью GetResponseHeader, затем сохраните файл (ы) с потоком ADO. – Jeeped

[Это] (http://stackoverflow.com/a/32429348/2165759) может помочь. – omegastripes

Ниже довольно распространенный пример я адаптировано для Вашего случая, он показывает использование XHR и RegEx для извлечения содержимого HTML веб-страницы, извлечь все ссылки из него, и загрузить нужный файл для каждого Линка:

Option Explicit 

Sub Test() 
    ' declare vars 
    Dim sUrl As String 
    Dim sReqProt As String 
    Dim sReqAddr As String 
    Dim sReqPath As String 
    Dim sContent As String 
    Dim oLinks As Object 
    Dim oMatch As Object 
    Dim sHref As String 
    Dim sHrefProt As String 
    Dim sHrefAddr As String 
    Dim sHrefPath As String 
    Dim sHrefFull As String 
    Dim n As Long 
    Dim aContent() As Byte 
    ' set source URL 
    sUrl = "https:\\......\links.html" 
    ' process source URL 
    SplitUrl sUrl, sReqProt, sReqAddr, sReqPath 
    If sReqProt = "" Then sReqProt = "http:" 
    sUrl = sReqProt & "//" & sReqAddr & "/" & sReqPath 
    ' retrieve source page HTML content 
    With CreateObject("Microsoft.XMLHTTP") 
     .Open "GET", sUrl, False 
     .Send 
     sContent = .ResponseText 
    End With 
    ' parse source page HTML content to extract all links 
    Set oLinks = CreateObject("Scripting.Dictionary") 
    With CreateObject("VBScript.RegExp") 
     .Global = True 
     .MultiLine = True 
     .IgnoreCase = True 
     .Pattern = "<a.*?href *= *(?:'|"")(.*?)(?:'|"").*?>" 
     For Each oMatch In .Execute(sContent) 
      sHref = oMatch.subMatches(0) 
      SplitUrl sHref, sHrefProt, sHrefAddr, sHrefPath 
      If sHrefProt = "" Then sHrefProt = sReqProt 
      If sHrefAddr = "" Then sHrefAddr = sReqAddr 
      sHrefFull = sHrefProt & "//" & sHrefAddr & "/" & sHrefPath 
      oLinks(oLinks.Count) = sHrefFull 
     Next 
    End With 
    ' save each link target into file 
    For Each n In oLinks 
     sHref = oLinks(n) 
     With CreateObject("Microsoft.XMLHTTP") 
      .Open "GET", sHref, False 
      .Send 
      aContent = .ResponseBody 
     End With 
     With CreateObject("ADODB.Stream") 
      .Type = 1 ' adTypeBinary 
      .Open 
      .Write aContent 
      .SaveToFile "C:\Test\" & n & ".xml", 2 ' adSaveCreateOverWrite 
      .Close 
     End With 
    Next 
End Sub 

Sub SplitUrl(sUrl, sProt, sAddr, sPath) 
    ' extract protocol, address and path from URL 
    Dim aSplit 
    aSplit = Split(sUrl, "//") 
    If UBound(aSplit) = 0 Then 
     sProt = "" 
     sAddr = sUrl 
    Else 
     sProt = aSplit(0) 
     sAddr = aSplit(1) 
    End If 
    aSplit = Split(sAddr, "/") 
    If UBound(aSplit) = 0 Then 
     sPath = sAddr 
     sAddr = "" 
    Else 
     sPath = Mid(sAddr, Len(aSplit(0)) + 2) 
     sAddr = aSplit(0) 
    End If 
End Sub

Этот метод не использует автоматизацию IE. Обычно файлы cookie IE, которые обрабатываются Microsoft.XMLHTTP, достаточны для ссылки на текущий сеанс, поэтому, если ваш сайт не использует дополнительные процедуры для аутентификации и генерирует список ссылок, то метод должен работать на вас.

источник

2015-09-26 20:00:18 omegastripes

VBA Macro для загрузки нескольких файлов из ссылок в IE

ответ

Смежные вопросы