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