Ir para conteúdo
Fórum Script Brasil
  • 0

1) Como salvar pdfs provenientes de um hyperlink 2) em uma pasta direcionada 3) e baixar esses arquivos renomeados de acordo com uma coluna da planilha 4) Usando VBA


GSS

Pergunta

Olá, pessoal!

 

Como tenho pouca experiência em VBA, estou com dificuldade em desenvolver um código para atender minha necessidade. Garimpando na internet encontrei alguns códigos prontos que ajudaram em partes, mas não toda minha necessidade.

 

Tenho uma planilha do excel com duas colunas:

coluna A: exame da Semana - novembro - 07-11-2022.pdf

coluna B: https://drive.google.com/uc?export=download&id=1 

 

Gostaria de salvar esse pdf do hiperlink com o nome de acordo com a coluna A no endereço C:\teste\

 

Encontrei este código, mas ele vai direto para meus downloads, ignorando as etapas de: alteração do nome do arquivo e também ignorando pasta que eu quero salvá-lo:

 

Sub OpenHyperLinks()
'Update 20141124
    Dim xHyperlink As Hyperlink
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    For Each xHyperlink In WorkRng.Hyperlinks
        xHyperlink.Follow
    Next
End Sub

 

_________________________________________________________________________________________________________________________

Esse outro código que encontrei, o resultado foi o que eu queria, porém os arquivos abrem como corrompidos:

 

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

Sub FazDownloadArquivos()
'macro que faz o download de arquivos a partir da URL da PLANILHA DADOS

Dim NomeDiretorio As String
Dim SiteArquivo, NomeSalvar As String
Dim Resultado, i As Integer

NomeDiretorio = "\\Documents\teste MACRO exame\"
If Dir(NomeDiretorio, vbDirectory) = "" Then
MsgBox "Deu ruim, o diretório não existe!"
Else
For i = 2 To 6
SiteArquivo = Worksheets("Recebimento_Exames").Cells(i, 2)
NomeSalvar = NomeDiretorio & Worksheets("Recebimento_Exames").Cells(i, 1).Value & ".pdf"
Resultado = URLDownloadToFile(0, SiteArquivo, NomeSalvar, 0, 0)
If Resultado <> 0 Then
MsgBox "Não consegui achar o arquivo  " & SiteArquivo
End If
Next i
End If
End Sub

 

 

ALGUÉM DA COMUNIDADE PODE ME AJUDAR?

 

Obrigada!!!

 

 

Editado por GSS
Link para o comentário
Compartilhar em outros sites

0 respostass a esta questão

Posts Recomendados

Até agora não há respostas para essa pergunta

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,5k
×
×
  • Criar Novo...