Gê Reiz

Bom dia. Fiz algumas alterações no Código acima e consegui adpatar a minha necessidade! Muito obrigado pela ajuda!

Boa tarde. Chegando em casa a noite, irei olhar com mais calma. Este código lista os arquivos, é isso??

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