At 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 Action!Watch this video to see this macro in action.
***Video coming soon!***
The 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 CreateFolderPerFileType() ' 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 = "C:\Users\Lever\Leverage & Lean\Posts\Excel\Excel Create Folder per File Type\TESTING" '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