Solução da falha no protocolo HTTPS de exemplo

Origem: 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)

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

Rapaz vc nao sabe o tanto que me salvo eu tava usando a forma antiga e tava dando problema que a foto no servidor tava de pe quando descia e carregava no form ficava virada tentei de tudo mais sem sucesso ai adaptei tua forma funciono perfeito a foto vem normal

tava usando dessa forma

Código:

strarquivo = Me!Foto1

If Me.Foto1 = "SemImagem" Then
Me.FT1.Picture = CurrentProject.Path & "\Img\noimg.jpg"


Else
     
80      url = "https://" & p_site & "/img/candidatos/" & Foto1
90      CaminhoLocal = CurrentProject.Path & "\Img\Candidatos\" & strarquivo
100     Auxiliar = URLDownloadToFile(0, url, CaminhoLocal, 0, 0)

110     If Dir(Nz(CaminhoLocal, " "), vbArchive) <> "" Then
120         Me.FT1.Picture = CaminhoLocal


130     End If

140 End If

Olá a todos,

Franklin Crivelaro, só vi hoje, obrigado pela contribuição.
Marcelo Antonio, obrigado pelo seu testemunho.

Abraço

Mestre Álvaro Teixeira.
Com o tanto que esse forum já me ensinou e me ajudou, o mínimo que posso fazer é contribuir compartilhando soluções que achei externas ou que desenvolvi e não tenha por aqui.

Abraço