Ir para conteúdo
Fórum Script Brasil

GSS

Membros
  • Total de itens

    1
  • Registro em

  • Última visita

Sobre GSS

GSS's Achievements

0

Reputação

  1. 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!!!
×
×
  • Criar Novo...