Move PDF file to a different folder based on cell values

excelnovice_2022

New Member
Joined
Jun 22, 2022
Messages
1
Office Version
  1. 365
Platform
  1. Windows
I am looking for a script/code for a macro that will, based on certain criteria which is contained in an excel spreadsheet, sort and move a large volume of PDF files from a general folder on One Drive into individual folders (also on One Drive). I tried to look at a similar question & answer to this thread [Move Files To Dynamic Folders Based On Cell Value (linked)], but it doesn't provide for my direct need and I am having a hard time figuring out how to correctly tweak my script (again, definitely a novice and wanting to learn more!). Any help would be appreciated!!

I have approximately 400 PDF files that all start with "ABC" and then list a unique code number (e.g., "ABC 0123456789", "ABC 1234567890", "ABC 2345678901" and so on). I want to automatically sort and move individual PDF files based on their unique code number (listed in Column E of my excel spreadsheet) into individual corresponding folders, which were already created and named according to a reference number ("1", "2", "3", so on; listed in Column A of my excel spreadsheet).

The script I reviewed to see if I could figure out how to tweak it (from Move Files to Dynamic Folders Based on Cell Value, linked above):

Sub MyMoveMacro()

Dim fpick As Object
Dim fldr As String
Dim wb As Workbook
Dim newFldr As String
Dim newFldrExists As String

Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object

Application.ScreenUpdating = False

' Browse for folder
Set fpick = Application.FileDialog(4)
With fpick
.Title = "Select a Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub
fldr = .SelectedItems(1)
End With
If Right(fldr, 1) <> "\" Then fldr = fldr & "\"
MsgBox "fldr is: " & fldr

' Set file system objects
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(fldr) 'Initialize folder
Set oFiles = oFolder.Files

' Loop through all Excel files in the folder
For Each oFile In oFiles
If (oFile Like "*.xls*") Then
' Open file
Set wb = Workbooks.Open(Filename:=oFile)
' Get new folder name from cell E8
newFldr = fldr & Sheets("Order Template").Range("E8").Value
If Right(newFldr, 1) <> "\" Then newFldr = newFldr & "\"
MsgBox "newFldr is: " & newFldr
' Check to see if folder exists
newFldrExists = Dir(newFldr, vbDirectory)
If newFldrExists = "" Then
' Create new directory
MkDir newFldr
End If
' Save file to new directory
wb.SaveAs Filename:=newFldr & wb.Name
' Close workbook
wb.Close
End If
Next oFile

' Delete Excel files in original location
Kill fldr & "*.xls*"

Application.ScreenUpdating = True

MsgBox "Macro Complete!"

End Sub
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top