Hi,

I work with thousands of pdf files that I constantly need to rename.  I have a batch file that will pull the full path of every pdf file and files in all subfolers and put it into an excel sheet, column A.  I would like to be able to have the full path in column A and type a new filename in column B, then push a button and have that actual file name change within the folder.  This was QUITE the puzzle. With the help of Microsoft Support and my own cockeyed view of scripting in general, I came up with this: a single VBScript to replace your batch file. This will recursively add full file names to column A of an Excel worksheet, create a Custom toolbar on the Excel Addins toolbar, and create a button (with a palm icon) to rename the PDF files based on column B of the worksheet.

Code: [Select]'List All Files Recursively
'
strFolder = "c:\temp"   'change to LOCAL folder

Set fso = CreateObject("Scripting.FileSystemObject")
Set fc = fso.GetFolder(strFolder).Files

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add()
Set xlSheet = xlBook.Worksheets(1)

xlRow = 0
RecurseFolders fso.GetFolder(strFolder)
ExcelStuff()

Set xlRange = xlSheet.UsedRange
xlRange.Columns.Autofit

Set xlRange = xlSheet.Columns("B:B")
xlRange.ColumnWidth = 25

xlApp.Visible = True

Sub RecurseFolders(Folder)
  Set fc = Folder.files
  For Each fs In fc
    If LCase(fso.GetExtensionName(fs)) = "pdf" Then
      xlRow = xlRow + 1
      xlSheet.Cells(xlRow, 1).Value = fs.Path
    End If
  Next

  For Each objFolder In Folder.subFolders
    RecurseFolders objFolder
  Next
End Sub

Sub ExcelStuff()
  ' Create Module & Macro
  '
  Set xlModule = xlBook.VBProject.VBComponents.Add(1)
 
  strCode = _
    "Sub NewNames()"                                                                     & vbCrLf & _
    "  Dim xlSheet As Worksheet"                                                         & vbCrLf & _
    "  Dim fso As Object"                                                                & vbCrLf & _
    "  Set fso = CreateObject(" & chr(34) & "Scripting.FileSystemObject" & chr(34) & ")" & vbCrLf & _
    "  Range(" & chr(34) & "A1" & chr(34) & ").Select"                                   & vbCrLf & _     
    "  Do Until IsEmpty(ActiveCell)"                                                     & vbCrLf & _
    "    If Not IsEmpty(ActiveCell.Offset(0, 1)) Then"                                   & vbCrLf & _
    "      Set fs = fso.getfile(ActiveCell.Value)"                                       & vbCrLf & _
    "      fx = ActiveCell.Offset(0, 1).Value"                                           & vbCrLf & _
    "      fs.Name = fx"                                                                 & vbCrLf & _
    "    End If"                                                                         & vbcrlf & _
    "    ActiveCell.Offset(1, 0).Select"                                                 & vbCrLf & _
    "  Loop"                                                                             & vbCrLf & _
    "End Sub"                                                                            & vbCrLf
     
  xlmodule.CodeModule.AddFromString strCode
 
  ' Create a new toolbar
  '
  Set cbs = xlapp.CommandBars
  Set cb = cbs.Add("Special", 1, , True)
  cb.Visible = True

  ' Create a button & assign to macro
  '
  Set cbc = cb.Controls.Add(1)
  With cbc
    .OnAction = "NewNames"
    .Caption = "NewNames"
    .ToolTipText = "PDF Renames"
    .FaceId = 51
  End with
End Sub

The script writes the VBA module script and attaches it to the worksheet. Check Macro Security on the Excel Developer toolbar. The "Enable All Macros" radio button must be selected and the "Trust Access To VBA Project Object Model" checkbox must be ticked. If you save the workbook, use file type of "Excel Macro-Enabled Workbook (*.xlsm).

Save the script with a VBS extension and run from the command line as: wscript scriptname.vbs. When the script runs, column A is filled with the file names. After you finish filling column B with new names, click the Excel Add-Ins toolbar and in the Custom Toolbars, click the hand icon. The renames iterates column A until it finds a blank cell then quits. If column B is empty, the file in column A is not renamed.

I wasn't sure how to end everything, so after the renames, the spreadsheet just sort of lies there. Feel free to manually close it.

Good luck.

Thanks for the quick response, Sidewinder, I greatly appreciate all the work you put into this!  So far, I've been able to execute the command which entered all of my filenames in column A as is supposed to.  I typed a few new names in column B for testing purposes (do I have to include any of the path or .pdf extension? or can it just simply be a "name"?)

When I click the add-ins toolbar and the palm icon, I get a vb compile error, highlighting the set "fs =" part of the Sub NewNames () script.  The error says "Variable not Defined". 

In terms of 'feature requests', is it possible to have an address bar in the add-ins ribbon to set the location?  Vs. manually entering the location in the script?  On our server, we have several job folders, each containing the thousands of pdf's i MENTIONED.  I only work on 1 job at a time, but do move around, being able to quickly define my starting location would be great.

Thanks again for you're help! much much appreciated

[recovering disk space, attachment deleted by admin]I can't reproduce your error. I made a fix to what the message indicates is the error. You'll have to do the actual test on your machine.

A prompt has been added to retrieve the PDF folder. It is no longer hard coded in the script.

The palm icon has been changed to a happy face (don't ask). I still haven't figured out how to have text with the icon.

Column B will accept file names with or without EXTENSIONS. File names without extensions default to .pdf
Do not use path names in column B.

Column C is used as an indicator that the renames has been processed for each file. This is simply FYI.

Code: [Select]'
'Plug PDF Files Into XLS
'
Set fso = CreateObject("Scripting.FileSystemObject")

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add()
Set xlSheet = xlBook.Worksheets(1)

Do
strFolder = InputBox("Enter PDF Folder:", "Recursive PDF Finder")
Loop Until fso.FolderExists(strFolder)

Set fc = fso.GetFolder(strFolder).Files

xlRow = 0
RecurseFolders fso.GetFolder(strFolder)
ExcelStuff()

Set xlRange = xlSheet.UsedRange
xlRange.Columns.Autofit

Set xlRange = xlSheet.Columns("B:B")
xlRange.ColumnWidth = 25
xlRange.Cells.NumberFormat = ""

Set xlRange = xlSheet.Columns("C:C")
xlRange.ColumnWidth = 25
xlRange.Cells.NumberFormat = ""
xlApp.Visible = True

Sub RecurseFolders(Folder)
  Set fc = Folder.files
  For Each fs In fc
    If LCase(fso.GetExtensionName(fs)) = "pdf" Then
      xlRow = xlRow + 1
      xlSheet.Cells(xlRow, 1).Value = fs.Path
    End If
  Next

  For Each objFolder In Folder.subFolders
    RecurseFolders objFolder
  Next
End Sub

Sub ExcelStuff()
  ' Create Module & Macro
  '
  Set xlModule = xlBook.VBProject.VBComponents.Add(1)
 
  strCode = _
    "Sub NewNames()"                                                                     & vbCrLf & _
    "  Dim xlSheet As Worksheet"                                                         & vbCrLf & _
    "  Dim fso As Object"                                                                & vbCrLf & _
    "  Dim fs As Object"                                                                 & vbCrLf & _
    "  Dim fx As String"                                                                 & vbCrLf & _
    "  Set fso = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")" & vbCrLf & _
    "  Range(" & Chr(34) & "A1" & Chr(34) & ").Select"                                   & vbCrLf & _     
    "  Do Until IsEmpty(ActiveCell)"                                                     & vbCrLf & _
    "    If Not IsEmpty(ActiveCell.Offset(0, 1)) Then"                                   & vbCrLf & _
    "      Set fs = fso.getfile(ActiveCell.Value)"                                       & vbCrLf & _
    "      fx = ActiveCell.Offset(0, 1).Value"                                           & vbCrLf & _
    "      If fso.GetExtensionName(fx) = "  & Chr(34) & Chr(34) & "Then"                 & vbCrLf & _
    "        fs.Name = fx &" & Chr(34) & ".pdf" & Chr(34)                                & vbCrLf & _
    "      Else"                                                                         & vbCrLf & _
    "        fs.Name = fx"                                                               & vbCrLf & _
    "      End If"                                                                       & vbCrLf & _
    "      ActiveCell.Offset(0, 2).Value = " & Chr(34) &  "File Renamed" & Chr(34)       & vbcrlf & _
    "    End If"                                                                         & vbcrlf & _
    "    ActiveCell.Offset(1, 0).Select"                                                 & vbCrLf & _
    "  Loop"                                                                             & vbCrLf & _
    "End Sub"                                                                            & vbCrLf
     
  xlmodule.CodeModule.AddFromString strCode
 
  ' Create a new toolbar
  '
  Set cbs = xlapp.CommandBars
  Set cb = cbs.Add("Special", 1, , True)      ' Command Bar Temporary
  cb.Visible = True

  ' Create a button & assign to macro
  '
  Set cbc = cb.Controls.Add(1)
  With cbc
    .OnAction = "NewNames"
    .Caption = "PDF Renames"
    .FaceId = 59
  End with
End Sub

In my previous post I mentioned you could save the workbook with a XLSM extension and work with it later. Not true! The VBA macro is temporary and even if you use a XLSM extension, the macro disappears anyway. To make the macro permanent is an easy tweak but the change is global for all future workbooks you may work with. Not sure you wanted that.

Good Luck.  This is exactly what I was looking for! Thank you soo much!

I have a preexisting xlbs file in my appdata excel start folder containing several other macro's.  Is it possible to add this to that so that It is an option in the ribbon anytime I have excel open?

Also, is it possible to put a browse location button in the drop down when it asks for the folder location?

Thank you very much!cincyshirm61,

XLSB files appear to be a global repositories for Excel macros. The snippet below is the VBA code generated by the VBScript. This link should help you add the macro to your XLSB file.

VBA Macro:
Code: [Select]Sub NewNames()
  Dim xlSheet As Worksheet
  Dim fso As Object
  Dim fs As Object
  Dim fx As String
  Set fso = CreateObject("Scripting.FileSystemObject")
  Range("A1").Select
  Do Until IsEmpty(ActiveCell)
    If Not IsEmpty(ActiveCell.Offset(0, 1)) Then
      Set fs = fso.getfile(ActiveCell.Value)
      fx = ActiveCell.Offset(0, 1).Value
      If fso.GetExtensionName(fx) = "" Then
        fs.Name = fx & ".pdf"
      Else
        fs.Name = fx
      End If
      ActiveCell.Offset(0, 2).Value = "File Renamed"
    End If
    ActiveCell.Offset(1, 0).Select
  Loop
End Sub

Once you've done that, much of the VBScript code can be eliminated:

Code: [Select]'Plug PDF Files Into XLS
'
Const RETURN_ONLY_FOLDERS = &H0001
Const WINDOW_HANDLE = 0
Const MY_COMPUTER = 17

Set objShell  = CreateObject( "Shell.Application" )
Set objFolder = objShell.BrowseForFolder( WINDOW-HANDLE, "Select Folder", RETURN_ONLY_FOLDERS, MY_COMPUTER )
If TypeName(objFolder) = "Nothing" Then
  WScript.Echo "User Cancelled Script"
  WScript.Quit
End If
Set objFolder = objFolder.Self
strFolder = objFolder.Path

Set fso = CreateObject("Scripting.FileSystemObject")
Set fc = fso.GetFolder(strFolder).Files

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add()
Set xlSheet = xlBook.Worksheets(1)

xlRow = 0
RecurseFolders fso.GetFolder(strFolder)

Set xlRange = xlSheet.UsedRange
xlRange.Columns.Autofit

Set xlRange = xlSheet.Columns("B:B")
xlRange.ColumnWidth = 25
xlRange.Cells.NumberFormat = ""

Set xlRange = xlSheet.Columns("C:C")
xlRange.ColumnWidth = 25
xlRange.Cells.NumberFormat = ""
xlApp.Visible = True

Sub RecurseFolders(Folder)
  Set fc = Folder.files
  For Each fs In fc
    If LCase(fso.GetExtensionName(fs)) = "pdf" Then
      xlRow = xlRow + 1
      xlSheet.Cells(xlRow, 1).Value = fs.Path
    End If
  Next

  For Each objFolder In Folder.subFolders
    RecurseFolders objFolder
  Next
End Sub

When you run the script, the spreadsheet will be created with the PDF files listed in column A. No longer will the VBA macro and button (happy face) be created. After filling in column B, you can run the VBA macro from the ribbon as you would any other personal macro.

The InputBox (prompt) has been replaced with the standard Windows BrowseForFolder control.

Happy Days.  Am I correct that in order to use this, I must always first run the script file, browse for my location, then that will import the paths into a new excel sheet, then run the macro?  I pasted the rename macro into my personal.xlsb file and it works great!  Instead of using the script you've provided, I find it would be easier to pair with my existing method.  Most of our work is done on a network drive, and for whatever folder I need the pathnames on I drag and drop a simple batch file to the folder, and this spits out a notepad file of the names.

Code: [Select]echo on

set pth = %~dp0

dir /s /b %pth%*.pdf >%pth%names.txt

end
from here I paste the names into column A, my renames in column B, then run your macro and Im good!

Thank you for the link to the post explaining putting macro's in the ribbon, did this with all of them, much more convenient, thank you very much!After my last reply, the sequence of events changed:

1. Run the VBScript to fill the spreadsheet with PDF file names
2. Fill in column B with the new names
3. Run the NewNames macro attached to the ribbon

You can replace step 1 above with your original batch file method. Results will be the same.

 

I'd like to mention that the (already FIXED) "Variable not defined" Error was the result of "Option Explicit" being automatically inserted into every Module that is added.