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

    Download Direto Dropbox de varios arquivos da pasta

    avatar
    NADIRONUNES
    Super Avançado
    Super Avançado

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 508
    Registrado : 30/08/2010

    Download Direto Dropbox de varios arquivos da pasta Empty Download Direto Dropbox de varios arquivos da pasta

    Mensagem  NADIRONUNES 27/2/2021, 17:35

    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

    boa tarde eu uso esse codigo do Alvaro Teixeira, so que nao estou conseguindo baixar varios aquivos de uma vez cada arquivo teria que gerar um link e alterar na Me.txtURL

    tem como baixar os arquivos da pasta sem gerar um link pra cada um?
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

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

    Download Direto Dropbox de varios arquivos da pasta Empty Re: Download Direto Dropbox de varios arquivos da pasta

    Mensagem  ahteixeira 1/3/2021, 22:23

    Olá Nadir,

    Pode criar um link da pasta e baixar compactado, depois será só descompactar, fica a sugestão Wink

    Abraço
    avatar
    NADIRONUNES
    Super Avançado
    Super Avançado

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 508
    Registrado : 30/08/2010

    Download Direto Dropbox de varios arquivos da pasta Empty Re: Download Direto Dropbox de varios arquivos da pasta

    Mensagem  NADIRONUNES 2/3/2021, 12:11

    mas essa pasta sempre sera atualizada
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

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

    Download Direto Dropbox de varios arquivos da pasta Empty Re: Download Direto Dropbox de varios arquivos da pasta

    Mensagem  ahteixeira 2/3/2021, 12:16

    Olá Nadir,

    E volta a fazer download se for necessário, o link será o mesmo.
    De outra forma vai sempre precisar do link dos ficheiros

    Abraço
    avatar
    NADIRONUNES
    Super Avançado
    Super Avançado

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 508
    Registrado : 30/08/2010

    Download Direto Dropbox de varios arquivos da pasta Empty Re: Download Direto Dropbox de varios arquivos da pasta

    Mensagem  NADIRONUNES 2/3/2021, 12:57

    so q nao to conseguindo gerar esse link
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

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

    Download Direto Dropbox de varios arquivos da pasta Empty Re: Download Direto Dropbox de varios arquivos da pasta

    Mensagem  ahteixeira 2/3/2021, 19:47

    Olá Nadir,

    Entre no seu Dropbox "online" e tente fazer a partilha da pasta.
    Tenha atenção que tem que ter uma pasta, veja exemplo:

    Download Direto Dropbox de varios arquivos da pasta 0163

    Abraço
    avatar
    NADIRONUNES
    Super Avançado
    Super Avançado

    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 508
    Registrado : 30/08/2010

    Download Direto Dropbox de varios arquivos da pasta Empty Re: Download Direto Dropbox de varios arquivos da pasta

    Mensagem  NADIRONUNES 2/3/2021, 20:10

    deu certo obrigado ahteixeira

    agora falta a parte de tirar o zip da pasta
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às regras : Respeito às Regras 100%

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

    Download Direto Dropbox de varios arquivos da pasta Empty Re: Download Direto Dropbox de varios arquivos da pasta

    Mensagem  ahteixeira 2/3/2021, 20:19

    Olá Nadir,

    Fico feliz por ter dado certo.

    Não falta exemplos no fórum para descompactar, ainda recentemente disponibilizei um exemplo via 7-zip:
    https://www.maximoaccess.com/t39146-ver-ficheiros-jpg-ou-pdf-no-controlo-webbrowser-descompactar-via-7-zip

    Veja veja como fazer uma "Busca":
    https://www.maximoaccess.com/t1115-busca-no-forum-search

    Sou da opinião que deve encerrar o tópico para não misturar questões.

    Abraço


      Data/hora atual: 13/6/2021, 00:09