[Renomear vários arquivos com VBA]

Bom dia. 

Fiz algumas alterações no Código acima e consegui adpatar a minha necessidade!

Muito obrigado pela ajuda!

[Renomear vários arquivos com VBA]

Boa tarde.

Chegando em casa a noite, irei olhar com mais calma. 

Este código lista os arquivos, é isso??

 

 

[Renomear vários arquivos com VBA]

Bom dia.

Desenvolvi um código para renomear aquivos pdf de uma pasta através do VBA. o Código abre o arquivo (NF), extrai o nome do cliente na nota, fecha o arquivo e renomeia com o nome do cliente. Porém gostaria de fazer através de um laço que pegasse todos os arquivos da pasta e fizesse o mesmo, mas só consegui fazer em um arquivo indicando o caminho dele.

Agradeço qualquer ajuda, e segue o código abaixo:

Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Dim AdobeFile As String

Sub Copiar_Dados_PDF_Start()

Dim AdobeApp As String
Dim StartAdobe

    
    
    AdobeApp = "C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"
    AdobeFile = ThisWorkbook.Path & "\NF\Damires - NF.pdf"
     
  
    StartAdobe = Shell("" & AdobeApp & " " & """" & AdobeFile & """" & "", 1)
    
    AdobeFile = VBA.Replace(VBA.Right(AdobeFile, VBA.Len(AdobeFile) - VBA.InStrRev(AdobeFile, "\")), ".pdf", "")
    
    Application.OnTime Now + TimeValue("00:00:03"), "FirstStep"
    
End Sub


Private Sub FirstStep()
    SendKeys ("^a")
    SendKeys ("^c")
    Application.OnTime Now + TimeValue("00:00:02"), "SecondStep"
    
End Sub


Private Sub SecondStep()
Dim ws As Worksheet
Dim i!

    
    On Error Resume Next
     AppActivate Application.Caption
    On Error GoTo 0
  
   With ThisWorkbook
   .Activate
    For i = 1 To .Worksheets.Count
    If .Sheets(i).Name = "..." Then
    .Sheets(i).Activate
    .Sheets(i).Cells.Clear
     Exit For
    End If
     Next
    End With
    
    Sheets("...").Range("A1").Activate
    SendKeys ("^v")
    Sleep 1000
    SendKeys ("{RIGHT}")

    Application.OnTime Now + TimeValue("00:00:02"), "fechapdf"
    
    
End Sub


Private Sub fechapdf()

Dim KillPdf As String

KillPdf = "TASKKILL /F /IM AcroRd32.exe"
Shell KillPdf, vbHide

Application.OnTime Now + TimeValue("00:00:02"), "extrairRazao"

End Sub


Private Sub extrairRazao()

Dim Razao As String


Razao = Sheets("...").Range("A17").Value
pontos = InStr(1, Razao, ":")
qtdeLetras = Len(Razao)
nome = Right(Razao, qtdeLetras - pontos)
Sheets("...").Range("E5").Value = nome

' MsgBox nome

Application.OnTime Now + TimeValue("00:00:02"), "renomeaPfd"

End Sub


Private Sub renomeaPfd()

Name "C:\Users\Georgie\Documents\ENVIO DE EMAILS\NF\Damires - NF.pdf" As "C:\Users\Georgie\Documents\ENVIO DE EMAILS\NF\" & Sheets("...").Range("E5").Value & " - NF.pdf"


End Sub