Início
franklin.crivelaro 10/1/2023, 03:14Origem: Exemplo Download Direto / Download Direto Dropbox
Caros Companheiros do Forum,
Eu me deparei com uma falha ao tentar usar a api URLDownloadToFile que não gerava erro quando o download do arquivo é oriundo de uma url que utiliza o protocolo HTTPS.
Com protocolo HTTP funciona corretamente.
A solução identifiquei no link abaixo, abandonando o uso da api URLDownloadToFile e quero compartilhar com vocês:
stackoverflow.com/questions/34923409/excel-vba-urldownloadtofile-error-for-httpsresource
No código de exemplo abaixo, na chamada da sub é passado a url e caminho de destino (com nome do arquivo e extensão)
Caros Companheiros do Forum,
Eu me deparei com uma falha ao tentar usar a api URLDownloadToFile que não gerava erro quando o download do arquivo é oriundo de uma url que utiliza o protocolo HTTPS.
Com protocolo HTTP funciona corretamente.
A solução identifiquei no link abaixo, abandonando o uso da api URLDownloadToFile e quero compartilhar com vocês:
stackoverflow.com/questions/34923409/excel-vba-urldownloadtofile-error-for-httpsresource
No código de exemplo abaixo, na chamada da sub é passado a url e caminho de destino (com nome do arquivo e extensão)
- Código:
Private Sub BaixaArquivo()
call download_arquivo("https:\\suaurl","C:seudiretorio\seuarquivo.txt")
end sub
Public Sub download_arquivo(strurl As String, strpath_destino As String)
Dim oStream As Object
Dim WinHttpReq As Object
Set WinHttpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
WinHttpReq.Option(4) = 13056 ' Ignora Erros devido a certificado SSL
On Error GoTo fim
WinHttpReq.Open "GET", strurl, False
WinHttpReq.setRequestHeader "Accept", "*/*"
WinHttpReq.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
WinHttpReq.setRequestHeader "Proxy-Connection", "Keep-Alive"
WinHttpReq.Send
'pega o retorno da chamada e passa para a var
strurl = WinHttpReq.responseBody
'se o status do retorno for 200, existe a url, cria um objeto de stream e passa o retorno para ele
If WinHttpReq.status = 200 Then
Set oStream = CreateObject("ADODB.Stream")
oStream.Open
oStream.Type = 1
oStream.Write WinHttpReq.responseBody
'salva o arquivo baixado no destino passado no parâmetro
oStream.SaveToFile strpath_destino, 2
'fecha o objeto
oStream.Close
Else
'se o status não for de ok, apresenta msg ao usuário com o erro
MsgBox "Código do Retorno:" & WinHttpReq.status & vbCr & "O Download não foi autorizado", vbExclamation, "Falha no download"
End If
Exit Sub
fim:
MsgBox Err.Description, vbExclamation, "Erro"
End Sub
