Moving Files from folders less than specific size

mrtim2232

New Member
Joined
Aug 24, 2017
Messages
48
Hi All,

I'm after a program that will loop through all folders and files in a directory regardless of what file type they are that are less than a specific size lets say 15GB and move them to a folder that it creates on the desktop called the less than 15gb and the date and then go through the same files and folders and move everything greater than 15gb to a different folder of the desktop.

Any help would be appreciated.
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Hopefully this will get you started :)
You should probably add som errorchecking and check file permissions.

Code:
Option Explicit


' Change these to fit your needs
Private Const copyMode As Integer = 16 ' Answers "yes to all", more info: https://docs.microsoft.com/en-us/windows/win32/shell/folder-copyhere
Private Const maxFileSize As Long = 15 * 1000000 ' Size is evaluated in bytes
Private Const startPath As String = "YOUR START PATH"


' Initializing Shell and Filesystem
Private Shell As New Shell32.Shell
Private FSO As New Scripting.FileSystemObject


' Destination on desktop
Private destGreatOrEqual As Shell32.Folder3
Private destLesser As Shell32.Folder3


'/ Set reference to:
''  Microsoft Shell controls and automation
''  Microsoft Scripting Runtime
Sub MoveFiles( _
)
  
  '' Init
  Set destLesser = getdestinationFldr("less than 15gb")
  Set destGreatOrEqual = getdestinationFldr("greater than 15gb")
  
  '' Procedure
  RecursiveFolder Shell.Namespace(startPath)
        
End Sub






'/ Check file size and move file to desktop
'' Go recursively through subfolders
Private Sub RecursiveFolder( _
parentFldr As Shell32.Folder3 _
)


On Error Resume Next


  '' Variables
  Dim item As Shell32.FolderItem
  
  '' Proc
  For Each item In parentFldr.Items
    ' Loop recursively if folder
    If item.IsFolder Then
      RecursiveFolder item
      
    '' Check file size and move if greater than 15GB
    ElseIf item.IsFileSystem Then
      
      ' Files greater than or EQUAL 15GB
      If FSO.GetFile(item.Path).Size >= maxFileSize Then
        
        destGreatOrEqual.CopyHere item
      
      ' Files smaller than 15GB (14.99999999)
      Else
        
        destLesser.CopyHere item, copyMode
        
      End If
      
    End If
  Next
  
  '' ****tproc
  If Err.Number <> 0 Then
    Debug.Print "Unexpteded error in RecursiveFolder"; Err.Number, Err.Description
    Err.Clear
  End If


End Sub






'/ Returns the destination on your desktop
'' If no folder is present, a new folder is created
Private Function getdestinationFldr( _
folderName As String _
) As Shell32.Folder3


  '' Variables
  Dim desktopFldr As Shell32.Folder3


  '' Proc
  Set desktopFldr = Shell.Namespace(ssfDESKTOP) ' Desktop is a special folder, use string path if you want to
  
  ' Create new folder if folder is not present
  If desktopFldr.ParseName(folderName) Is Nothing Then
    desktopFldr.NewFolder folderName
  End If
  
  '' Retval
  Set getdestinationFldr = desktopFldr.ParseName(folderName).GetFolder


End Function
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,938
Members
448,534
Latest member
benefuexx

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