Macro IntroAt home you open a messy closet and think to yourself how am I supposed to find anything in here! Similar situation you open a Folder on your computer and see different Files scattered all over. While we can’t automate the application of 5s for your closet we have plenty of opportunities to do so on your computer! This macro will navigate to the Folder path that you indicate in the VBA code looping through all files that are not within a Folder. For each unique File Type found a NEW Folder will be created moving any files of that type into that Folder. If you want to take this macro to the next level you can subscribe as an Insider gaining additional VBA Code that will allow you to list out multiple Folder Paths directly in the Excel Workbook. Below the Folder Paths you will also be able to list NEW Folders you want created and Files with specific File Extensions you want to be moved into each respective Folder. Example is all Excel Workbooks are moved into one Folder instead of .xlsx and .csv files being placed into separate Folder. Any remaining Files found but not indicated in the Excel Workbook will have separate Folders created for their File Extension.
See it in ActionWatch this video to see this macro in action.
***Video coming soon!***
CodeHere is the code for this macro. Make sure the following References are setup before running it: Visual Basic For Applications, Microsoft Excel 16.0 Object Library
'Leverage & Lean "Less Clicks, More Results" Sub CreateFolderPerFileTypeFreeMacro() ' Means that these variables are in use Dim Counter As Integer ' Dim FolderPath As String ' Dim Folders As String ' Dim fso As Object ' Dim oFile As Object ' Dim oFolder As Object ' On Error GoTo LeverageLean FolderPath = "" 'You can update the FolderPath to somewhere else Set fso = CreateObject("Scripting.FileSystemObject") Set oFolder = fso.GetFolder(FolderPath) 'Set Folder to loop through For Each oFile In oFolder.Files 'Loop through every File in FolderPath If oFile.Type <> "File folder" Then 'If the File isn't a Folder If fso.FolderExists(FolderPath & "\" & oFile.Type) Then 'The Folder has been found Else: fso.CreateFolder (FolderPath & "\" & oFile.Type) 'The Folder has been created If Folders = "" Then Folders = oFile.Type Counter = 1 ElseIf Folders <> "" Then Folders = Folders & vbNewLine & oFile.Type Counter = Counter + 1 End If End If fso.MoveFile Source:=FolderPath & "\" & oFile.Name, Destination:=FolderPath & "\" & oFile.Type & "\" & oFile.Name 'Move the File to the Folder created End If Next oFile MsgBox "Successfully created " & Counter & " Folders for the following types " & vbNewLine & Folders Exit Sub LeverageLean: MsgBox (Err.Number & " - " & Err.Description & vbNewLine & vbNewLine & "Don't hesitate to email me: firstname.lastname@example.org") End Sub 'Stay Awesome
Insider ContentHere is the Insider code for this macro. This code will allow you to setup an Excel Workbook to list multiple Folder Paths for this macro to loop through and manage what Files should go to what Folders! Make sure the following References are setup before running it: Visual Basic For Applications, Microsoft Excel 16.0 Object Library
CustomizationThese segments of code can be customized to personalize this macro.
Populate the FolderPath variable with the Folder Path where you want the macro to complete it’s creation of file type folders and move files to their respective NEW folder.
MsgBox "Successfully created " & Counter & " Folders for the following types " & vbNewLine & Folders
By Default the Create Folder Per File Type Macro will display a MsgBox upon completion. The MsgBox will display the total number of Folders created and the File Types used. If you would prefer to not see a MsgBox upon running this macro then remove this code line or make this MsgBox a comment.