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
Bookmarks