Moving Files from folders less than specific size

[mrtim2232]

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.

 

[Fredrik1987]

Hopefully this will get you started
You should probably add som errorchecking and check file permissions.

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