excel vba – Renomear Vários arquivos PDF com VBA

Boa tarde.

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:

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)AdobeAcrobat Reader DCReaderAcroRd32.exe"
    AdobeFile = ThisWorkbook.Path & "NFDamires - 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:UsersGeorgieDocumentsENVIO DE EMAILSNFDamires - NF.pdf" As "C:UsersGeorgieDocumentsENVIO DE EMAILSNF" & Sheets("...").Range("E5").Value & " - NF.pdf"


End Sub