Notifications
Clear all

Progresso de download

3 Posts
2 Usuários
0 Reactions
1,163 Visualizações
mdosmagos
(@mdosmagos)
Posts: 78
Trusted Member
Topic starter
 

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
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Bom dia!!!

Veja se ajuda..
http://forums.devshed.com/windows-help- ... 30213.html

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 02/08/2014 5:13 am
mdosmagos
(@mdosmagos)
Posts: 78
Trusted Member
Topic starter
 

Pelo visto é bem mais difícil do que imaginei.... Vou deixar sem. Mas valeu pela ajuda... Muito Obrigado....

 
Postado : 02/08/2014 3:41 pm