Can I add to a file size splitting routine.

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

Open in new window

glenn mastersAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewIT / Software Engineering ConsultantCommented:
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

I don't understand what you want here, can you expand?  Do you want the subfolders that were created in SPLIT to be moved up a level to DOWNLOADS?  If so then why not just change the strDestDir to DOWNLOADS before running the scrit and create them there in the first place?

»bp
Bill PrewIT / Software Engineering ConsultantCommented:
This should add the player.exe to each split folder, adjust the path to the EXE near the top.

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"
strPlayer = "C:\TEMP\player.exe"

' 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)
strPlayer = objFSO.GetAbsolutePathname(strPlayer)

' 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

    ' Add player file
    objFSO.CopyFile strPlayer, strNextDir

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

Open in new window

»bp

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
glenn mastersAuthor Commented:
Hi

Apologies for delay in reply.
 
Thanks
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.