Masterresende

Fala galera, Gostaria de uma ajuda de vocês Estou utilizando um código no VBA do Excel que até chegou a funcionar, baixando o arquivo normal (. Exe) 3.2mb Mas não sei o que rolou que o arquivo baixando exibe 2k tipo não baixou corretamente e exibe a msg que está corrompido, detalhe desativei antivirus porque achei que poderia ser ele mas nada! E chegou a funcionar como disse... Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000 Private Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long Private Declare PtrSafe Function InternetReadBinaryFile Lib "wininet.dll" Alias "InternetReadFile" (ByVal hfile As Long, ByRef bytearray_firstelement As Byte, ByVal lNumBytesToRead As Long, ByRef lNumberOfBytesRead As Long) As Integer Private Declare PtrSafe Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal sURL As String, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long Private Declare PtrSafe Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer Private Sub cmdDownload_Click() Dim sURL, CaminhoLocal, sFicheiro As String If IsNull(myURL) Then Exit Sub sURL = myURL sURL = ("https://www.dropbox.com/s/o8qql9kinec1eqc/exemplooooo") 'alterar url para download direto If Right(sURL, 5) <> "?dl=1" Then MsgBox "Não é um link preparado para download direto do Dropbox.", vbCritical, "Operação cancelada" Exit Sub End If sFicheiro = Right(sURL, Len(sURL) - InStrRev(sURL, "/")) sFicheiro = Left(sFicheiro, Len(sFicheiro) - 5) CaminhoLocal = myURLCaminho & sFicheiro Dim hInternet, hSession, lngDataReturned As Long, sBuffer() As Byte, totalRead As Long Const bufSize = 128 ReDim sBuffer(bufSize) hSession = InternetOpen("", 0, vbNullString, vbNullString, 0) If hSession Then hInternet = InternetOpenUrl(hSession, sURL, vbNullString, 0, INTERNET_FLAG_NO_CACHE_WRITE, 0) Set ostream = CreateObject("ADODB.Stream") ostream.Open ostream.Type = 1 If hInternet Then iReadFileResult = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned) ReDim Preserve sBuffer(lngDataReturned - 1) ostream.Write sBuffer ReDim sBuffer(bufSize) totalRead = totalRead + lngDataReturned myURLEstado = "A fazer Download do ficheiro. " & CLng(totalRead / 1024) & " KB recebidos." DoEvents Do While lngDataReturned <> 0 iReadFileResult = InternetReadBinaryFile(hInternet, sBuffer(0), UBound(sBuffer) - LBound(sBuffer), lngDataReturned) If lngDataReturned = 0 Then Exit Do ReDim Preserve sBuffer(lngDataReturned - 1) ostream.Write sBuffer ReDim sBuffer(bufSize) totalRead = totalRead + lngDataReturned myURLEstado = "A fazer Download do ficheiro. " & CLng(totalRead / 1024) & " KB recebidos." DoEvents Loop myURLEstado = "Download completo." ostream.SaveToFile CaminhoLocal, 2 ostream.Close End If Call InternetCloseHandle(hInternet) End Sub