asked on
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.
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
VB Script
Last Comment
glenn masters
ASKER CERTIFIED SOLUTION
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
ASKER
Hi
Apologies for delay in reply.
Thanks
Apologies for delay in reply.
Thanks
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