MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


5 participantes

    Exemplo Download Direto / Download Direto Dropbox

    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Exemplo Download Direto / Download Direto Dropbox Empty Exemplo Download Direto / Download Direto Dropbox

    Mensagem  Alvaro Teixeira 16/2/2017, 16:04

    Olá,
    A propósito de questão de colega, partilho exemplo adapatdo para Download Direto.
    Código utilizado:
    Código:
    Option Compare Database
    ' Autor ..: Alvaro Teixeira (ahteixeira)
    ' Para ...: MaximoAccess.com
    ' Data ...: 16-02-2017
    ' Função .: Download Directo
    ' Adaptado: http://www.maximoaccess.com/t28700-baixar-arquivos-de-sites-como-googledrive-mega-ou-outro

    #If VBA7 Then
        Private Declare PtrSafe 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
    #Else
        Private 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
      

    Private Sub cmdDownload_Click()
        On Error GoTo Err
        Dim Auxiliar As Long
        Dim URL, CaminhoLocal, sFicheiro As String
        
        URL = Me.txtURL
        sFicheiro = Right(URL, Len(URL) - InStrRev(URL, "/"))
        CaminhoLocal = Me.txtCaminho & sFicheiro
        
        Auxiliar = URLDownloadToFile(0, URL, CaminhoLocal, 0, 0)
        
        If Auxiliar = 0 Then
           MsgBox "Download efetuado com sucesso!", vbInformation
        Else
           MsgBox "Erro no download do arquivo.", vbCritical, ""
        End If
        Exit Sub

    Err:
       MsgBox Err.Number & "-" & Err.Description, vbCritical, "Erro no download do arquivo."
    End Sub

    Abraço


    Última edição por ahteixeira em 10/3/2017, 20:10, editado 2 vez(es)
    avatar
    danilo451
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 24
    Registrado : 19/04/2016

    Exemplo Download Direto / Download Direto Dropbox Empty Re: Exemplo Download Direto / Download Direto Dropbox

    Mensagem  danilo451 9/3/2017, 15:21

    Muito bom Obrigado

    Fernando Lucas gosta desta mensagem

    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Exemplo Download Direto / Download Direto Dropbox Empty Re: Exemplo Download Direto / Download Direto Dropbox

    Mensagem  Alvaro Teixeira 10/3/2017, 20:19

    Olá a todos,
    Eliminei o exemplo da mensagem nº 1.
    Agora tem mais um exemplo que permite fazer o download direto de link do Dropbox.

    Código utilizado:
    Código:
    Option Compare Database
    ' Autor ..: Alvaro Teixeira (ahteixeira)
    ' Para ...: MaximoAccess.com
    ' Data ...: 10-03-2017
    ' Função .: Download Directo
    ' Adaptado: http://analystcave.tumblr.com/post/136973006098/how-to-download-files-using-vba-in-excel

    Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
    Private Declare 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 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 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 Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer


    Private Sub cmdDownload_Click()
        Dim sURL, CaminhoLocal, sFicheiro As String
            
        If IsNull(Me.txtURL) Then Exit Sub
        
        sURL = Me.txtURL
        sURL = Replace(sURL, "?dl=0", "?dl=1") '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 = Me.txtCaminho & 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
        Me.txtEstado = "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
          Me.txtEstado = "A fazer Download do ficheiro. " & CLng(totalRead / 1024) & " KB recebidos."
          DoEvents
        Loop

        Me.txtEstado = "Download completo."
        ostream.SaveToFile CaminhoLocal, 2
        ostream.Close
      End If
      Call InternetCloseHandle(hInternet)
    End Sub

    O ficheiro anexo tem este exemplo e o da mensagem nº 1.

    cheers
    Anexos
    Exemplo Download Direto / Download Direto Dropbox Attachmentdownload_Direto_Dropbox.zip
    Você não tem permissão para fazer download dos arquivos anexados.
    (26 Kb) Baixado 319 vez(es)

    Fernando Lucas gosta desta mensagem

    pcnet
    pcnet
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 302
    Registrado : 16/12/2015

    Exemplo Download Direto / Download Direto Dropbox Empty Re: Exemplo Download Direto / Download Direto Dropbox

    Mensagem  pcnet 10/3/2017, 21:23

    Olá boa noite,

    Testei e tenho a dizer que está excelente (,")
    Muito obrigado pela partilha mestre AhTeixeira.

    Abraço
    leoni_dias
    leoni_dias
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 179
    Registrado : 14/08/2011

    Exemplo Download Direto / Download Direto Dropbox Empty Re: Exemplo Download Direto / Download Direto Dropbox

    Mensagem  leoni_dias 21/9/2018, 13:07

    Bom dia, ahteixeira.

    Exemplo perfeito, só perguntaria se tem como alterá-lo para ser mais rápido... achei um pouco lento.

    Obrigado.
    Uilson Brasil
    Uilson Brasil
    VIP
    VIP


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 1039
    Registrado : 23/04/2013

    Exemplo Download Direto / Download Direto Dropbox Empty Re: Exemplo Download Direto / Download Direto Dropbox

    Mensagem  Uilson Brasil 21/9/2018, 17:02

    leoni_dias,

    A velocidade de download não depende do código escrito pelo amigo "ahteixeira" e sim da velocidade de conexão com a internet, bem como do tamanho do arquivo.


    .................................................................................
    ::: Uilson Brasil
    ::: Design in Microsoft Access
    leoni_dias
    leoni_dias
    Intermediário
    Intermediário


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 179
    Registrado : 14/08/2011

    Exemplo Download Direto / Download Direto Dropbox Empty Re: Exemplo Download Direto / Download Direto Dropbox

    Mensagem  leoni_dias 21/9/2018, 18:47

    Boa tarde.

    Eu acredito não ser bem assim, Uilson.

    Eu fiz um mesmo download de 1,8 mega, usando o código, o google e automatcamente pelo próprio dropbox instalado no pc e usando a mesma internet.

    Pelo google e pelo dropbox do pc foram bem mais rápido do que pelo código, e olha que não testei em arquivos que uso que são de 25 megas +-.

    Testei na prática pra poder fazer a pergunta sobre a rapidez.
    Alvaro Teixeira
    Alvaro Teixeira
    Moderador Global
    Moderador Global


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 7914
    Registrado : 15/03/2013

    Exemplo Download Direto / Download Direto Dropbox Empty Re: Exemplo Download Direto / Download Direto Dropbox

    Mensagem  Alvaro Teixeira 17/3/2023, 12:50

    Olá a todos,

    No link abaixo para quem pretender com https, contribuíção do colega Franklin Crivelaro:
    https://www.maximoaccess.com/t41872-solucao-da-falha-no-protocolo-https-de-exemplo

    Bons estudos
    cheers

    Fernando Lucas gosta desta mensagem


      Data/hora atual: 29/3/2024, 01:34