troubleshooting Question

Can I add to a file size splitting routine.

Avatar of glenn masters
glenn masters asked on
VB Script
3 Comments1 Solution89 ViewsLast Modified:
I have the script below that was expertely done by Bill on here but I have other issues that I need to add to it if poss.


What I need to do is after they all split into the file sizes I need them moved from X:\DOWNLOADS\SPLIT to C:\DOWNLOADS and then if poss every new folder that  was created  I need it to add a .exe file called "player.exe" .

Is that possible.
Option Explicit

' Global variables
Dim strBaseDir, strDestDir
Dim objFSO, objFile
Dim arrFiles(), i
Dim lngFolderSize, intFolderNumber, strNextDir, intMoveFile

' Define paths to work with
strBaseDir = "X:\DOWNLOADS"
strDestDir = "X:\DOWNLOADS\SPLIT"

' Global variables
Dim strBaseDir, strDestDir
Dim objFSO, objFile
Dim arrFiles(), i
Dim lngFolderSize, intFolderNumber, strNextDir, intMoveFile

' Define paths to work with
strBaseDir = "B:\EE\EE29124343\base"
strDestDir = "B:\EE\EE29124343\dest"

' Set maximum size of new folders
Const cMaxFolderSize = 500000000

' Define class that will hold file information
Class File
    Public lngSize
    Public strPath
End Class 

' Create file system object
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

' Fully resolve paths
strBaseDir = objFSO.GetAbsolutePathname(strBaseDir)
strDestDir = objFSO.GetAbsolutePathname(strDestDir)

' Make sure the folders exists, exit if not
If Not objFSO.FolderExists(strBaseDir) Then
    WScript.Echo "*ERROR* Folder does not exist: """ & strBaseDir & """."
    WScript.Quit
End If
If Not objFSO.FolderExists(strDestDir) Then
    WScript.Echo "*ERROR* Folder does not exist: """ & strDestDir & """."
    WScript.Quit
 End If
 
' Initialize array index variable
i = -1

' Load info for each file into array (using File class)
For Each objFile In objFSO.GetFolder(strBaseDir).Files
    ' Don't include any files with size greater than max allowed in a folder
    If objFile.Size > cMaxFolderSize Then
        WScript.Echo "*WARNING* Skipping file: """ & objFile.Path & """, size:""" & objFile.Size & """ exceeds maximum folder size:""" & cMaxFolderSize & """."
    Else
        ' Add another element to the array of type File class
        i = i + 1
        ReDim Preserve arrFiles(i)
        Set arrFiles(i) = New File

        ' Store the size and full path to the file
        arrFiles(i).strPath = objFile.Path
        arrFiles(i).lngSize = objFile.Size
    End If
Next

' If no files found then exit
If i = -1 Then
    WScript.Echo "*WARNING* No files found to process."
    WScript.Quit
End If

' Sort the files arrary by size in descending order
SortArray arrFiles

' Process all files moving to new subfolders until done
intFolderNumber = 0
Do
    ' Start a new destination folder and create it (MUST NOT ALREADY EXIST)
    lngFolderSize = cMaxFolderSize
    intFolderNumber = intFolderNumber + 1
    strNextDir = strDestDir & "\" & intFolderNumber & "\"
    objFSO.CreateFolder strNextDir

    ' Move files to dest folder until full
    Do
        ' Look for the largest file left that will fit in remaining space
        intMoveFile = GetFileToMove(arrFiles, lngFolderSize)

        ' If we found another file to move then move it
        If intMoveFile <> -1 Then
            Wscript.Echo "*DEBUG* Dest:[" & intFolderNumber & "], Available:[" & lngFolderSize & "], File:[" & arrFiles(intMoveFile).strPath & "], Size:[" & arrFiles(intMoveFile).lngSize & "]."
            objFSO.MoveFile arrFiles(intMoveFile).strPath, strNextDir
            lngFolderSize = lngFolderSize - arrFiles(intMoveFile).lngSize
            arrFiles(intMoveFile).lngSize = -1
        End If
    Loop Until intMoveFile = -1

Loop Until AllFilesMoved(arrFiles)

Function GetFileToMove(ByRef arrArray(), lngSize)
    ' Find next largest file to move that fits, -1 if none found
    Dim i
    GetFileToMove = -1
    For i = LBound(arrArray) To UBound(arrArray)
        If arrArray(i).lngSize <> -1 Then
            If arrArray(i).lngSize <= lngSize Then
                GetFileToMove = i
            End If
            Exit Function
        End If
    Next
End Function

Function AllFilesMoved(ByRef arrArray())
    ' See if all files have been moved
    Dim i
    AllFilesMoved = True
    For i = LBound(arrArray) To UBound(arrArray)
        If arrArray(i).lngSize <> -1 Then
            AllFilesMoved = False
            Exit Function
        End If
    Next
End Function

Sub SortArray(ByRef arrArray())
    ' Sort array of files by size, descending order (simple bubble sort)
    Dim i, j, intTemp
    For i = LBound(arrArray) to UBound(arrArray)
        For j = LBound(arrArray) to UBound(arrArray) - 1
'            If arrArray(j).lngSize < arrArray(j + 1).lngSize Then
            If LCase(arrArray(j).strPath) > LCase(arrArray(j + 1).strPath) Then
                Set intTemp = arrArray(j + 1)
                Set arrArray(j + 1) = arrArray(j)
                Set arrArray(j) = intTemp
                Set intTemp = Nothing
            End If
        Next
    Next
End Sub

"

' Set maximum size of new folders
Const cMaxFolderSize = 500000000

' Define class that will hold file information
Class File
    Public lngSize
    Public strPath
End Class 

' Create file system object
Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")

' Fully resolve paths
strBaseDir = objFSO.GetAbsolutePathname(strBaseDir)
strDestDir = objFSO.GetAbsolutePathname(strDestDir)

' Make sure the folders exists, exit if not
If Not objFSO.FolderExists(strBaseDir) Then
    WScript.Echo "*ERROR* Folder does not exist: """ & strBaseDir & """."
    WScript.Quit
End If
If Not objFSO.FolderExists(strDestDir) Then
    WScript.Echo "*ERROR* Folder does not exist: """ & strDestDir & """."
    WScript.Quit
 End If
 
' Initialize array index variable
i = -1

' Load info for each file into array (using File class)
For Each objFile In objFSO.GetFolder(strBaseDir).Files
    ' Don't include any files with size greater than max allowed in a folder
    If objFile.Size > cMaxFolderSize Then
        WScript.Echo "*WARNING* Skipping file: """ & objFile.Path & """, size:""" & objFile.Size & """ exceeds maximum folder size:""" & cMaxFolderSize & """."
    Else
        ' Add another element to the array of type File class
        i = i + 1
        ReDim Preserve arrFiles(i)
        Set arrFiles(i) = New File

        ' Store the size and full path to the file
        arrFiles(i).strPath = objFile.Path
        arrFiles(i).lngSize = objFile.Size
    End If
Next

' If no files found then exit
If i = -1 Then
    WScript.Echo "*WARNING* No files found to process."
    WScript.Quit
End If

' Sort the files arrary by size in descending order
SortArray arrFiles

' Process all files moving to new subfolders until done
intFolderNumber = 0
Do
    ' Start a new destination folder and create it (MUST NOT ALREADY EXIST)
    lngFolderSize = cMaxFolderSize
    intFolderNumber = intFolderNumber + 1
    strNextDir = strDestDir & "\" & intFolderNumber & "\"
    objFSO.CreateFolder strNextDir

    ' Move files to dest folder until full
    Do
        ' Look for the largest file left that will fit in remaining space
        intMoveFile = GetFileToMove(arrFiles, lngFolderSize)

        ' If we found another file to move then move it
        If intMoveFile <> -1 Then
            Wscript.Echo "*DEBUG* Dest:[" & intFolderNumber & "], Available:[" & lngFolderSize & "], File:[" & arrFiles(intMoveFile).strPath & "], Size:[" & arrFiles(intMoveFile).lngSize & "]."
            objFSO.MoveFile arrFiles(intMoveFile).strPath, strNextDir
            lngFolderSize = lngFolderSize - arrFiles(intMoveFile).lngSize
            arrFiles(intMoveFile).lngSize = -1
        End If
    Loop Until intMoveFile = -1

Loop Until AllFilesMoved(arrFiles)

Function GetFileToMove(ByRef arrArray(), lngSize)
    ' Find next largest file to move that fits, -1 if none found
    Dim i
    GetFileToMove = -1
    For i = LBound(arrArray) To UBound(arrArray)
        If arrArray(i).lngSize <> -1 Then
            If arrArray(i).lngSize <= lngSize Then
                GetFileToMove = i
            End If
            Exit Function
        End If
    Next
End Function

Function AllFilesMoved(ByRef arrArray())
    ' See if all files have been moved
    Dim i
    AllFilesMoved = True
    For i = LBound(arrArray) To UBound(arrArray)
        If arrArray(i).lngSize <> -1 Then
            AllFilesMoved = False
            Exit Function
        End If
    Next
End Function

Sub SortArray(ByRef arrArray())
    ' Sort array of files by size, descending order (simple bubble sort)
    Dim i, j, intTemp
    For i = LBound(arrArray) to UBound(arrArray)
        For j = LBound(arrArray) to UBound(arrArray) - 1
'            If arrArray(j).lngSize < arrArray(j + 1).lngSize Then
            If LCase(arrArray(j).strPath) > LCase(arrArray(j + 1).strPath) Then
                Set intTemp = arrArray(j + 1)
                Set arrArray(j + 1) = arrArray(j)
                Set arrArray(j) = intTemp
                Set intTemp = Nothing
            End If
        Next
    Next
End Sub
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 3 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 3 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros