Download de múltiplos arquivos via Excel

Neste caso basta informar o dados nas células de uma planilha e ler eles através da macro:

Sub DownloadEUnzip()
      ‘Declaração de variáveis
      Dim FSO, oApp As Object
      Dim objHttp, DefPath, Arquivo, aUrl, aPasta As String
      Dim Dados() As Byte
      Dim Fname As Variant
      Dim FileNameFolder As Variant
      Dim iFileNumber As Long
     
      For i = 1 To 20
          
         ‘Parâmetros iniciais (personalizáveis)
         aUrl = Cells(i, 1).Value
         aPasta = Cells(i, 2).Value
         Arquivo = aPasta & Cells(i, 3).Value
       
         ‘Download do Arquivo
         Set objHttp = CreateObject(“MSXML2.ServerXMLHTTP”)
         objHttp.Open “GET”, aUrl, False
         objHttp.Send
         If objHttp.Status = “200” Then
             Dados = objHttp.ResponseBody
             iFileNumber = FreeFile
             Open Arquivo For Binary Access Write As #iFileNumber
             Put #iFileNumber, 1, Dados
             Close #iFileNumber
         End If

 

Basta ter informado os URLs na primeira coluna, as pastas onde deve guardar os arquivos na segunda e o nome deles na terceira.

É importante salientar que as pastas já devem existir e não podem haver arquivos com o mesmo nome nas pastas.

Caso deseje descompactar os arquivos após o download:

Sub DownloadEUnzip()
      ‘Declaração de variáveis
      Dim FSO, oApp As Object
      Dim objHttp, DefPath, Arquivo, aUrl, aPasta As String
      Dim Dados() As Byte
      Dim Fname As Variant
      Dim FileNameFolder As Variant
      Dim iFileNumber As Long
     
      For i = 1 To 20
          
         ‘Parâmetros iniciais (personalizáveis)
         aUrl = Cells(i, 1).Value
         aPasta = Cells(i, 2).Value
         Arquivo = aPasta & Cells(i, 3).Value
       
         ‘Download do Arquivo
         Set objHttp = CreateObject(“MSXML2.ServerXMLHTTP”)
         objHttp.Open “GET”, aUrl, False
         objHttp.Send
         If objHttp.Status = “200” Then
             Dados = objHttp.ResponseBody
             iFileNumber = FreeFile
             Open Arquivo For Binary Access Write As #iFileNumber
             Put #iFileNumber, 1, Dados
             Close #iFileNumber
         End If
        
         ‘Descompactação o arquivo
         If Right(aPasta, 1) <> “\” Then
            aPasta = aPasta & “\”
         End If
         FileNameFolder = aPasta
         Set oApp = CreateObject(“Shell.Application”)
         oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Arquivo).items
    Next
   End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *

You may use these HTML tags and attributes: <a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <strike> <strong>