Here is a script i found and modified to my liking. I am having a problem getting it to loop thru all the files. Any help would be appreciated.
Thanks
------------------------------------------------------
Dim oFSO, wshShell, FileCol, oFolder, objTextFile, shareLength, strDeptShare, strFileName, folderArray, i, message, sLinkFile, oLink
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = WScript.CreateObject("WScript.Shell")
Set wshNetwork = WScript.CreateObject("WScript.Network")
'==========
'**** Configurable script options ****
'==========
'Location to search for files to archive from
defaultShare = "E:\Test"
'Location to move files to
defaultPath = "E:\ArchiveTest"
'Script searches for files older than this date
defaultDate = "08/31/2000"
'Move files from these folders only
'folderArray = array("InfoShared", "ISShared", "ISEngineering", "ISMgr", "ISOperations")
folderArray = array("somethingfolder")
'==========
'*********** Script begins ***********
'==========
shareName = inputbox("Please type the path to the file share you wish to search" & _
vbCrLf & "Leave this box empty for default path below:" & _
vbCrLf & defaultShare)
if shareName = "" then
shareName = defaultShare
end if
shareLength = len(shareName)
checkDate = inputbox("Please put in the date from which we are checking for modify date" & _
vbCrLf & "Leave this box empty for the default date below:" & _
vbCrLf & defaultDate)
if checkDate = "" then
checkDate = defaultDate
end if
daysSinceCheckDate = datediff("d", checkDate, date)
strMoveFileLocation = inputbox("Please type the path to place archived files and the file report" & _
vbCrLf & "Leave this box empty for the default path below:" & _
vbCrLf & defaultPath)
if strMoveFileLocation = "" then
strMoveFileLocation = defaultPath
end if
FileDIr = strMoveFileLocation & "\Files"
if not oFSO.FolderExists(FileDir) then
oFSO.CreateFolder(FileDir)
end if
'Error handling
on error resume next
logFile = strMoveFileLocation & "\" & "FileReport_DeptShares.csv"
tempFile = strMoveFileLocation & "\" & "tempfile_DeptShares.txt"
errorFile = strMoveFileLocation & "\" & "errors.txt"
if oFSO.FileExists(tempFile) then
oFSO.DeleteFile tempFile
end if
if not oFSO.FolderExists(shareName) then
wscript.echo "invalid start folder location"
wscript.quit
end if
if not oFSO.FolderExists(strMoveFileLocation) then
wscript.echo "invalid archive folder location"
wscript.quit
end if
set oFolder = oFSO.GetFolder(shareName)
Set colSubfolders = oFolder.Subfolders
strPreviousDeptShare = ""
strUserCount = "0"
'This message writes the column headers to the .csv file
message = "File Path " & "," & "File Name" & "," & "File type" & "," & _
"File Size (Bytes)" & "," & "File Age (Days)" & "," & _
"Date last accessed" & "," & "Date last modified"
writeLog logFile, message
'This calls the main subroutine
ShowFolders(oFolder)
wshShell.run "explorer.exe " & strMoveFileLocation
'wscript.echo "Done!"
wscript.quit
'==========
'*********** Subroutines *************
'==========
Sub ShowFolders(Folder)
For Each Subfolder in Folder.SubFolders
continue = 0
'Find out if the current subfolder is in the array of folders to search
for i = 0 to uBound(folderArray)
if subfolder.name = folderArray(i) then
continue = 1
end if
next
if continue = 1 then
set osubfolder = oFSO.GetFolder(Subfolder.Path)
on error goto 0 'Change error num back to 0
set FileCol = osubFolder.Files
for each fil in filecol
fileModifyDate = fil.DateLastModified
daysSinceModify = datediff("d", fileModifyDate, date)
'Move file only if it is older than modify date specified
if daysSinceModify > daysSinceCheckDate then
fileAge = datediff("d", fil.DateCreated, date)
fileLastAccess = fil.DateLastAccessed
'fileSizeMB = FormatNumber(fil.size/1048576, 0)
message = fil.path & "," & fil.name & "," & fil.type & "," & fil.size & "," & fileAge & "," & _
fileLastAccess & "," & fileModifyDate
writeLog logFile, message
fileNameLength = len(fil.name)
filePathLength = len(fil.path)
filePathDiff = filePathLength - (fileNameLength)
filePath = left(fil.path, filePathDiff)
fileFolderLength = filePathDiff - shareLength
fileFolderPath = right(filePath, fileFolderLength)
newFilePath = FileDir & fileFolderPath
'Make sure subfolder exists in new location, create if necessary
if not oFSO.FolderExists(newFilePath) then
oFSO.CreateFolder(newFilePath)
end if
fil.Move(newFilePath)
'create shortcut to new file
sLinkFile = fil.Path & "\" & fil.name & ".LNK"
Set oLink = wshShell.CreateShortcut(sLinkFile)
oLink.TargetPath = (Fil.Path & "\" & fil.name)
oLink.Save
'delete old file after move
oFSO.DeleteFile(fil.Path & "\" & fil.name)
end if
next
'Start subroutine again for each subfolder in folders collection
ShowSubFolders Subfolder
'An error here indicates permissions problem, log to error file
if err.number <> 0 then
writeLog errorFile, subfolder.path
end if
on error goto 0 'Change error num back to 0
end if
Next
End Sub
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
set osubfolder = oFSO.GetFolder(Subfolder.Path)
if err.number <> 0 then
writeLog errorFile, subfolder.path
end if
on error goto 0 'Change error num back to 0
set FileCol = osubFolder.Files
for each fil in filecol
fileModifyDate = fil.DateLastModified
daysSinceModify = datediff("d", fileModifyDate, date)
'Move file only if it is older than modify date specified
if daysSinceModify > daysSinceCheckDate then
fileAge = datediff("d", fil.DateCreated, date)
fileLastAccess = fil.DateLastAccessed
'fileSizeMB = FormatNumber(fil.size/1048576, 0)
message = fil.path & "," & fil.name & "," & fil.type & "," & fil.size & "," & fileAge & "," & _
fileLastAccess & "," & fileModifyDate
writeLog logFile, message
fileNameLength = len(fil.name)
filePathLength = len(fil.path)
filePathDiff = filePathLength - fileNameLength
filePath = left(fil.path, filePathDiff)
fileFolderLength = filePathDiff - shareLength
fileFolderPath = right(filePath, fileFolderLength)
newFilePath = FileDir & fileFolderPath
'Make sure subfolder exists in new location, create if necessary
if not oFSO.FolderExists(newFilePath) then
oFSO.CreateFolder(newFilePath)
'An error will occur if the parent folder of the folder being created
'does not exist. The script will now create missing folder tree
if err.number <> 0 then
on error goto 0 'Change error num back to 0
continueLooping = 1
strTempLoopDir = fileDir & "\"
Do while continueLooping = 1
shareLength = len(strTempLoopDir)
writeLog tempFile, newFilePath
Set objTextFile = oFSO.OpenTextFile(tempFile, 1, True)
Do while objTextFile.AtEndofStream <> True
if firstLoop <> "1" then
objTextFile.Skip(shareLength)
firstLoop = "1"
end if
strChar = objTextFile.Read(1)
if strChar <> "\" then
strShareFolderPath = strShareFolderPath + strChar
else exit do
end if
Loop
objTextFile.Close
if oFSO.FileExists(tempFile) then
oFSO.DeleteFile tempFile
end if
strLoopPath = strTempLoopDir & strShareFolderPath & "\"
if not oFSO.FolderExists(strLoopPath) then
'Create next folder folder tree
oFSO.CreateFolder(strLoopPath)
if strLoopPath = newFilePath then
'Folder tree has been built
continueLooping = 0
end if
end if
strTempLoopDir = strLoopPath
firstLoop = 0
strShareFolderPath = ""
Loop
shareLength = len(shareName)
end if
end if
'Move file to new location
fil.Move(newFilePath)
'create shortcut to new file
sLinkFile = fil.Path & "\" & fil.name & ".LNK"
Set oLink = wshShell.CreateShortcut(sLinkFile)
oLink.TargetPath = (Fil.Path & "\" & fil.name)
oLink.Save
'delete old file after move
oFSO.DeleteFile(fil.Path & "\" & fil.name)
end if
next
'Start subroutine again with next subfolder in collection
ShowSubFolders Subfolder
'An error here indicates permissions problem, log to error file
if err.number <> 0 then
writeLog errorFile, subfolder.path
end if
on error goto 0 'Change error num back to 0
Next
End Sub
Sub writeLog(strLogFile, strMessage)
const ForRead = 1
const ForWrite = 2
const ForAppend = 8
Set fsLog = oFSO.OpenTextFile(strLogFile, 8, True)
fsLog.WriteLine (strMessage)
fsLog.Close
End Sub
-------------------------------------------------