Boa tarde!
Uso este código para fazer download de atualização de uma planilha, ele faz o download ocultamente, terminando o download aparece o msgbox que coloquei, o que quero saber é se tem como alterar o código para que apareça o progresso do download? Desde já grato....
Option Explicit
#If VBA7 Then
Public Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr _
, ByVal szURL As String _
, ByVal szFileName As String _
, ByVal dwReserved As LongPtr _
, ByVal lpfnCB As LongPtr) As Long
#Else
Public Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long _
, ByVal szURL As String _
, ByVal szFileName As String _
, ByVal dwReserved As Long _
, ByVal lpfnCB As Long) As Long
#End If
Sub Atualização_Versão()
Dim MyPath1 As String
MyPath1 = ActiveWorkbook.Path & "" & "DOWNLOAD" & ""
If (Dir(MyPath1, vbDirectory) = "") Then
MkDir (MyPath1)
End If
Dim sURL As String
Dim sDestino As String
Dim blSucesso As Boolean
Dim Valida As String
Dim tamanhodownload As String
tamanhodownload = Worksheets("Atualização Geral").Range("C9").Value
Dim download As String
download = MsgBox("Será iniciada a transferência, clique em sim e aguarde a mensagem confirmando que a planilha foi baixada. Pode demorar vários minutos, depende da velocidade de sua internet. O tamanho do arquivo é de " & tamanhodownload & ". Confirma iniciar o download?", vbYesNo + vbQuestion, "PLANILHA DE PREÇOS")
If download = vbNo Then
Exit Sub
End If
sURL = Worksheets("Mural Online").Range("S33").Value & Worksheets("Mural Online").Range("S32").Value & ".xlsm"
sDestino = ThisWorkbook.Path & "DOWNLOAD" & "DK Planilha " & Worksheets("Mural Online").Range("S32").Value & ".xlsm"
blSucesso = DownloadArquivo(sURL, sDestino)
If blSucesso Then
MsgBox "Nova planilha baixada com sucesso. Salva na pasta DOWNLOAD." _
, vbInformation _
, "PLANILHA DE PREÇOS"
Else
MsgBox "Erro ao tentar baixar o arquivo! Verifique sua conexão com a internet ou algum bloqueio. O arquivo pode estar indisponivel no momento." _
, vbCritical _
, "PLANILHA DE PREÇOS"
End If
End Sub
Function DownloadArquivo(sURL As String, sDestino As String) As Boolean
Dim l As Long
l = URLDownloadToFile(0, sURL, sDestino, 0, 0)
If l = 0 Then DownloadArquivo = True
End Function
Postado : 01/08/2014 10:39 am