Rename Multiple PDF Files using Excel VBA

I have a compressed file consisting of 900+ PDF files. I have an excel reference file that has column A (account #), column B (brokerage #), column C (Entity). Currently all these pdfs are names with the account Number in their title. But I want to rename them to their brokerage # and group the accounts in folders separated by their entities (4 different types).

Is there a macro function to rename a list of pdf's using the account # - replace it with the corresponding brokerage number and group the pdfs in their respective entity folders. I can unzip the original folder before writing any macro but preferably dont want to.

Any help is appreciated.
Thanks

need the filename format of the existing pdf,
and how you want it to look when renamed.

Current PDF name: TaxForm_1099Comp_2017_1815_"1234567"
New PDF Name: GSB="0000000000"+CSP="TOPACCOUNT"+DOC=M1+TT=12312016+D=2016_PPP1099PAIRED
The values in "" in the current PDF name are dynamic based on column A in the reference file
The values in "" in the new PDF name are dynamic based on columns B and C in the reference file

you will need to adjust the code to fit you.
in make new filename:

      'make new filename
  vNewN = vAcct & vBrok & "_TOPACCOUNT_" & vRemTxt & ".pdf"

change the layout of your target filename.


change:
Sheets("Accounts").Activate
to the name of your excel sheetname with the accounts

in RenameFiles(),
change the Folder,"c:\temp\", where your pdfs are located

then run RenameFiles

Public Sub RenameFiles()
  RenameFilesInDir "c:\temp\"
End Sub


Private Sub RenameFilesInDir(ByVal pvSrcDir)
Dim FSO, oFolder, oFile, oRX
Dim sCriteria As String, sSrcFile As String
Dim iCnt As Integer, f As Integer, i As Integer
Dim vXFmt, vNewFile, vAcct, vBrok, vEnt
Dim wbApp As Workbook, wbFile As Workbook
Dim wsTarg As Worksheet
Dim vDirEnt, vRemTxt, vNewN

On Error GoTo errGetFiles

Sheets("Accounts").Activate

Set wbApp = ActiveWorkbook
If Right(pvSrcDir, 1) <> "\" Then pvSrcDir = pvSrcDir & "\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvSrcDir)

Sheets.Add
Set wsTarg = ActiveSheet
For Each oFile In oFolder.Files
  If InStr(oFile.Name, ".pdf") > 0 Then       'pdf only
         sSrcFile = pvSrcDir & oFile.Name
             
             'grab acct# from filename
         If i > 0 Then
                                   'Current PDF name: TaxForm_1099Comp_2017_1815_"1234567"
            f = InStrRev(oFile.Name, "_")
            vRemTxt = Left(oFile.Name, f)
            vAcct = Mid(oFile.Name, i + 1)
            vAcct = Left(vAcct, Len(vAcct) - 4)  'remove .pdf
            FindAcct vAcct
            
            'vAcct = ActiveCell.Offset(0, 0).Value
            vBrok = ActiveCell.Offset(0, 1).Value
            vEnt = ActiveCell.Offset(0, 2).Value
            
            If pvEnt <> "" Then
                   'make entity folder
                vDirEnt = pvDir & vEnt
                MakeDir vDirEnt
                
                   'make new filename
                vNewN = vAcct & vBrok & "_TOPACCOUNT_" & vRemTxt & ".pdf"
                vNewFile = vDirEnt & vNewN
                     
                     'rename it
                Name sSrcFile As vNewFile
            End If
         End If
  End If
Next
MsgBox "Done"
Set wbApp = Nothing
Set wbFile = Nothing
Set wsTarg = Nothing

endit:
Set oFile = Nothing
Set oFolder = Nothing
Set FSO = Nothing
Exit Sub

errGetFiles:
  MsgBox Err.Description, , Err
End Sub

Public Sub MakeDir(ByVal pvDir)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(pvDir) Then FSO.CreateFolder pvDir     'MkDir pvDir
Set FSO = Nothing
End Sub

Public Sub FindAcct(ByVal pvAcct, pvBrok, pvEnt)
On Error GoTo errFind

Columns("A:A").Select
Selection.Find(What:=pvAcct, After:=ActiveCell, LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate

    'pvAcct = ActiveCell.Offset(0, 0).Value
    pvBrok = ActiveCell.Offset(0, 1).Value
    pvEnt = ActiveCell.Offset(0, 2).Value
Exit Sub

errFind:
pvBrok = ""
pvEnt = ""
Debug.Print pvAcct & ": not found"
End Sub