I have a script that works perfectly for me to move files, create new folders then delete out old ones, however i am unable to add in a zipping function. I can do this separately but would like it in my script as i only want to run the one scheduled task.
Can anyone help?
Dim theDate, ArchiveDate
Dim CurPath
Dim BackupPath
Dim objFSO, objFolder, objFile
Dim ArchivePath
'theDate = InputBox("Date to archive (ddmmyy)")
theDate = DateAdd("d",-1, date())
dateArray = Split(theDate,"/")
theDate = dateArray(0) & dateArray(1) & Right(dateArray(2),2)
CurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
BackupPath = CurPath & "\" & thedate
ArchiveDate = CDate(left(theDate,2) & "/" & mid(theDate,3,2) & "/" & right(theDate,2))
ArchivePath = "E:\Log_Folder_1"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(CurPath)
'msgbox CurPath
'msgbox BackupPath
'msgbox ArchiveDate
For Each objFile In objFolder.Files
ModifiedDate = Split(objFile.DateLastModified," ")
If (CDate(ModifiedDate(0)) = ArchiveDate AND objFSO.GetExtensionName(objFile) <> "vbs") Then
'msgbox "yes " & objFile.DateLastModified
If objFSO.FolderExists(BackupPath) = false Then
objFSO.CreateFolder(BackupPath)
End If
objFile.Move BackupPath & "\" & objFile.Name
Else
'msgbox "no " & objFile.DateLastModified
End If
Next
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject")
If filesys.FolderExists(BackupPath) Then
filesys.CopyFolder "E:\Log_Folder_1" & "\" & thedate, "\\Backup_Server\Logs\Log_Folder_1"
End If
If objFSO.FolderExists(CurPath & "\" & theDate) Then
Set delFolder = objFSO.GetFolder(CurPath & "\" & theDate)
delFolder.Delete
End If
Dim keepDays
keepDays = -20
Do Until keepDays=-10
theDate = replace(DateAdd("d",keepDays, date()),"/","")
theDate = left(theDate,4) & right(theDate,2)
If objFSO.FolderExists ("\\Backup_Server\Logs\Log_Folder_1" & "\" & theDate) Then
Set delFolder = objFSO.GetFolder("\\Backup_Server\Logs\Log_Folder_1" & "\" & theDate)
delFolder.Delete
End If
keepDays=keepDays+1
Loop
Related
strFileName1 = "D:\log.txt"
strContent = "" & Now & Space(2) & dir & vbCr & vbLf
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objLogs = objFS.OpenTextFile(strFileName1, ForAppending, True)
objLogs.WriteLine(strContent)
objLogs.Close
I've never really written in vbs (once wrote a script that would welcome me on boot) but I'm after a script to essentially perform :
robocopy "folder1" "folder2" /MIR
At the moment what I've got is a copied script from here VBS Mirror, Using the top script :
This code synchronizes the contents (files and subfolders) of two
folders. Each folder is traversed recursively and any missing
subfolders and files are copied both ways. If corresponding folders
contain files with matching file names but with different time stamps,
the file with the newest time stamp will overwrite the older.
SyncFolders.vbs
Option Explicit
ForceScriptEngine("cscript")
Dim wshArgs
Set wshArgs = Wscript.Arguments
If WshArgs.Count = 2 Then
Call SyncFolders(WshArgs.Item(0), WshArgs.Item(1))
' Also run once in reverse to catch mismatching subfolder count:
Call SyncFolders(WshArgs.Item(1), WshArgs.Item(0))
Else
Wscript.Echo("Wrong number of arguments. Syntax: SyncFolders Folder1 Folder2")
Wscript.Sleep(3000) ' To allow Function syntax popup message to be seen.
End If
Sub SyncFolders(strFolder1, strFolder2)
Dim objFileSys
Dim objFolder1
Dim objFolder2
Dim objFile1
Dim objFile2
Dim objSubFolder
Dim arrFolders
Dim i
Set objFileSys = CreateObject("Scripting.FileSystemObject")
arrFolders = Array(strFolder1, strFolder2)
For i = 0 To 1 ' Make sure that missing folders are created first:
If objFileSys.FolderExists(arrFolders(i)) = False Then
wscript.echo("Creating folder " & arrFolders(i))
objFileSys.CreateFolder(arrFolders(i))
End If
Next
Set objFolder1 = objFileSys.GetFolder(strFolder1)
Set objFolder2 = objFileSys.GetFolder(strFolder2)
For i = 0 To 1
If i = 1 Then ' Reverse direction of file compare in second run
Set objFolder1 = objFileSys.GetFolder(strFolder2)
Set objFolder2 = objFileSys.GetFolder(strFolder1)
End If
For Each objFile1 in objFolder1.files
If Not objFileSys.FileExists(objFolder2 & "\" & objFile1.name) Then
Wscript.Echo("Copying " & objFolder1 & "\" & objFile1.name & _
" to " & objFolder2 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
Else
Set objFile2 = objFileSys.GetFile(objFolder2 & "\" & objFile1.name)
If objFile1.DateLastModified > objFile2.DateLastModified Then
Wscript.Echo("Overwriting " & objFolder2 & "\" & objFile1.name & _
" with " & objFolder1 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
End If
End If
Next
Next
For Each objSubFolder in objFolder1.subFolders
Call SyncFolders(strFolder1 & "\" & objSubFolder.name, strFolder2 & _
"\" & objSubFolder.name)
Next
Set objFileSys = Nothing
End Sub
Sub ForceScriptEngine(strScriptEng)
' Forces this script to be run under the desired scripting host.
' Valid arguments are "wscript" or "cscript".
' The command line arguments are passed on to the new call.
Dim arrArgs
Dim strArgs
For Each arrArgs In WScript.Arguments
strArgs = strArgs & " " & Chr(34) & arrArgs & Chr(34)
Next
If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "cscript.exe //Nologo " & _
Chr(34) & Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
Else
If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & _
Wscript.ScriptFullName & Chr(34) & strArgs
Wscript.Quit
End If
End If
End Sub
I changed the :
Sub SyncFolders(strFolder1, strFolder2)
to
Sub SyncFolders(strC:\Users\Zac\Desktop\Folder, strW:\Folder)
and get the error "Expected ')'
I'm sure it's something very obvious, but could someone please tell me what I need to change in that script to make my folders mirror each other?
Since this vbscript force to deal with Cscript engine; you should execute it by a litlle batch like this way :
#echo off
Cscript /nologo SyncFolders.vbs "C:\Users\Zac\Desktop\Folder" "W:\Folder"
pause
Edit :
And if you like to avoid this batch and using Cscript engine,try this :
Option Explicit
'You must only change the absolute paths of the two folders here
Call SyncFolders("C:\Users\Zac\Desktop\Folder","W:\Folder")
'**********************Don't Change nothing below this line *****************************
Sub SyncFolders(strFolder1, strFolder2)
Dim objFileSys
Dim objFolder1
Dim objFolder2
Dim objFile1
Dim objFile2
Dim objSubFolder
Dim arrFolders
Dim i
Set objFileSys = CreateObject("Scripting.FileSystemObject")
arrFolders = Array(strFolder1, strFolder2)
For i = 0 To 1 ' Make sure that missing folders are created first:
If objFileSys.FolderExists(arrFolders(i)) = False Then
'wscript.echo("Creating folder " & arrFolders(i))
objFileSys.CreateFolder(arrFolders(i))
End If
Next
Set objFolder1 = objFileSys.GetFolder(strFolder1)
Set objFolder2 = objFileSys.GetFolder(strFolder2)
For i = 0 To 1
If i = 1 Then ' Reverse direction of file compare in second run
Set objFolder1 = objFileSys.GetFolder(strFolder2)
Set objFolder2 = objFileSys.GetFolder(strFolder1)
End If
For Each objFile1 in objFolder1.files
If Not objFileSys.FileExists(objFolder2 & "\" & objFile1.name) Then
'Wscript.Echo("Copying " & objFolder1 & "\" & objFile1.name & _
' " to " & objFolder2 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
Else
Set objFile2 = objFileSys.GetFile(objFolder2 & "\" & objFile1.name)
If objFile1.DateLastModified > objFile2.DateLastModified Then
'Wscript.Echo("Overwriting " & objFolder2 & "\" & objFile1.name & _
' " with " & objFolder1 & "\" & objFile1.name)
objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
objFolder2 & "\" & objFile1.name
End If
End If
Next
Next
For Each objSubFolder in objFolder1.subFolders
Call SyncFolders(strFolder1 & "\" & objSubFolder.name, strFolder2 & _
"\" & objSubFolder.name)
Next
Set objFileSys = Nothing
End Sub
'********************************************************************************
I have a vbscript that copy's Outlook 2003 messages into a folder in msg format.
The problems are:
I am getting "path too long" errors for some *.msg . I wish to avoid these erros and I don't know how. ' On Error Resume Next is already on the script.
I am getting only inbox messages, but I want all subfolders too;
How can I extract this in *.txt and not in *.msg, in order to become lighter?
Here is my atual script. Thanks for the help!
On Error Resume Next
Dim myNameSpace
Dim ofChosenFolder
Dim myOlApp
Dim myItem
Dim objItem
Dim myFolder
Dim strSubject
Dim strName
Dim strFile
Dim strReceived
Dim strSavePath
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Const olFolderInbox = 6
Set ofChosenFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
strSavePath = "c:\test\" 'OBS! use a \ at the end of the path
i = 1
For each Item in ofChosenFolder.Items
Set myItem = ofChosenFolder.Items(i)
strReceived = ArrangedDate(myitem.ReceivedTime)
' strSubject = myItem.Subject
strSubject = myitem.SenderName & "_" & myitem.Subject
strName = StripIllegalChar(strSubject)
strFile = strSavePath & strReceived & "_" & strName & ".msg"
If Not Len(strfile) > 256 then
myItem.SaveAs strfile, 3
Else
wscript.echo strfile & vbcrlf & "Path and filename too long."
End If
i = i + 1
next
Function StripIllegalChar(strInput)
'***************************************************
'Simple function that removes illegal file system
'characters.
'***************************************************
Set RegX = New RegExp
RegX.pattern = "[\" & chr(34) & "\!\#\#\$\%\^\&\*\(\)\=\+\|\[\]\{\}\`\'\;\:\<\>\?\/\,]"
RegX.IgnoreCase = True
RegX.Global = True
StripIllegalChar = RegX.Replace(strInput, "")
Set RegX = nothing
End Function
Function ArrangedDate(strDateInput)
'***************************************************
'This function re-arranges the date data in order
'for it to display in chronilogical order in a
'sorted list in the file system. It also removes
'illegal file system characters and replaces them
'with dashes.
'Example:
'Input: 2/26/2004 7:07:33 AM
'Output: 2004-02-26_AM-07-07-33
'***************************************************
Dim strFullDate
Dim strFullTime
Dim strAMPM
Dim strTime
Dim strYear
Dim strMonthDay
Dim strMonth
Dim strDay
Dim strDate
Dim strDateTime
Dim RegX
If not Left(strDateInput, 2) = "10" Then
If not Left(strDateInput, 2) = "11" Then
If not Left(strDateInput, 2) = "12" Then
strDateInput = "0" & strDateInput
End If
End If
End If
strFullDate = Left(strDateInput, 10)
If Right(strFullDate, 1) = " " Then
strFullDate = Left(strDateInput, 9)
End If
strFullTime = Replace(strDateInput,strFullDate & " ","")
If Len(strFullTime) = 10 Then
strFullTime = "0" & strFullTime
End If
strAMPM = Right(strFullTime, 2)
strTime = strAMPM & "-" & Left(strFullTime, 8)
strYear = Right(strFullDate,4)
strMonthDay = Replace(strFullDate,"/" & strYear,"")
strMonth = Left(strMonthDay, 2)
strDay = Right(strMonthDay,len(strMonthDay)-3)
If len(strDay) = 1 Then
strDay = "0" & strDay
End If
strDate = strYear & "-" & strMonth & "-" & strDay
'strDateTime = strDate & "_" & strTime
strDateTime = strDate
Set RegX = New RegExp
RegX.pattern = "[\:\/\ ]"
RegX.IgnoreCase = True
RegX.Global = True
ArrangedDate = RegX.Replace(strDateTime, "-")
Set RegX = nothing
End Function
You need to truncate the file name appropriately (strName)
Move your code that processes a folder into a sub that take fodler that takes folder as parameter and call it for ofChosenFolder as well as all of its child fodlers in the ofChosenFolder.Folders collection.
You are calling SaveAs..., 3 - 3 here is olMsg. Specify olTxt (= 0).
Off the top of my head:
Const olFolderInbox = 6
Set ofChosenFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
trSavePath = "c:\test\"
ProcessFolder ofChosenFolder, trSavePath
sub ProcessFolder(folder, path)
For each Item in folder.Items
strReceived = ArrangedDate(Item.ReceivedTime)
strSubject = Item.SenderName & "_" &Item .Subject
strName = StripIllegalChar(strSubject)
strFile = strSavePath & strReceived & "_" & strName & ".msg"
If Not Len(strfile) > 256 then
Item.SaveAs strfile, 3
Else
wscript.echo strfile & vbcrlf & "Path and filename too long."
End If
next
for each subfolder in folder.Folders
ProcessFolder(subfolder, trSavePath & subfolder.Name & "\"
next
end sub
I managed to find this script to use and backup my files, this is a little more complicated then I need it to be.
I do not need to enter a backup path - from and too every time I run it however this is a handy option for other projects but I would like to backup from a set file path and save to a set file path to save time.
The other issue with this script is the Cancel button does not work, this is an issue I have had before and fixed but I cannot remember how to make the Cancel button function.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Set objFSO = CreateObject("Scripting.FileSystemObject")
strSourceFolder = InputBox("Enter the Source directory path you wish to backup")
strDestFolder = InputBox("Enter the Destination directory path you wish to backup your Data to... (C:/Backup, //Backup-Server/Remotebackup")
Wscript.Echo "Click (OK) to start the Backup!"
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
Function CopyFolderStructure(strSource, strDestination, strExcludedExt)
Const OVER_WRITE_FILES = True
Dim objDir, objFolder, objFiles, strCurExt, intX, arrExt, blnExclude
Set objDir = objFSO.GetFolder(strSource)
If Not objFSO.FolderExists(strDestination & "\" & objDir.Name) Then
objFSO.CreateFolder(strDestination & "\" & objDir.Name)
End If
If Not IsNoData(strExcludedExt) Then
arrExt = Split(strExcludedExt, ",")
blnExclude = False
End If
For Each objFiles In objFSO.GetFolder(strSource).Files
If Not IsNoData(strExcludedExt) Then
strCurExt = objFSO.GetExtensionName(objFiles.Name)
For intX = 0 To UBound(arrExt)
If LCase(strCurExt) = arrExt(intX) Then
blnExclude = True
Exit For
Else
blnExclude = False
End If
Next
If Not blnExclude Then
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Else
objFSO.CopyFile strSource & "\" & objFiles.Name, strDestination & "\" & objDir.Name & "\" & objFiles.Name, OVER_WRITE_FILES
End If
Next
For Each objFolder In objFSO.GetFolder(strSource).SubFolders
CopyFolderStructure objFolder.Path, strDestination & "\" & objDir.Name, strExcludedExt
Next
End Function
Function BrowseForFolderDialogBox(strTitle)
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = &H0001
Dim objShellApp
Dim objFolder
Dim objFldrItem
Dim objPath
Set objShellApp = CreateObject("Shell.Application")
Set objFolder = objShellApp.BrowseForFolder(WINDOW_HANDLE, strTitle , NO_OPTIONS)
If IsNoData(objFolder) Then
WScript.Echo "You choose to cancel. This will stop this script."
Wscript.Quit
Else
Set objFldrItem = objFolder.Self
objPath = objFldrItem.Path
BrowseForFolderDialogBox = objPath
Set objShellApp = Nothing
Set objFolder = Nothing
Set objFldrItem = Nothing
End If
End Function
Function IsNoData(varVal2Check)
On Error Resume Next
If IsNull(varVal2Check) Or IsEmpty(varVal2Check) Then
IsNoData = True
Else
If IsDate(varVal2Check) Then
IsNoData = False
Elseif varVal2Check = "" Then
IsNoData = True
ElseIf Not IsObject(varVal2Check) Then
IsNoData = False
Else
IsNoData = False
End If
End If
End Function
Wscript.Echo "Backup Has Completed Successfully"
Next code snippet could help (see Arguments Property (WScript Object), InputBox Function and MsgBox Function reference). Note that the Echo method behaves differently depending on which WSH engine you are using.
Option Explicit
Dim objFSO, strSourceFolder, strDestFolder, strExclusion, strPrompt
Dim iBut, sRes, sMes, objArgs
sRes = Wscript.ScriptName
sMes = vbCRLF & "(click (Cancel) button to discard)"
Set objArgs = WScript.Arguments
If objArgs.Count > 1 Then
strSourceFolder = objArgs( 0)
strDestFolder = objArgs( 1)
Else
strSourceFolder = "C:/DataToBackup"
strDestFolder = "D:/Backup"
strSourceFolder = InputBox( "Path you wish to backup" & sMes _
, "Source directory", strSourceFolder)
sRes = sRes & vbNewLine & "strSourceFolder """ & strSourceFolder & """"
If strSourceFolder = "" Then
strDestFolder = ""
Else
strDestFolder = InputBox( "Path you wish to backup your Data to" & sMes _
, "Destination directory", strDestFolder)
sRes = sRes & vbNewLine & "strDestFolder """ & strDestFolder & """"
End If
End If
If strDestFolder = "" Then
sRes = sRes & vbNewLine & "Backup Cancelled!"
Wscript.Echo sRes
Wscript.Quit
Else
iBut=MsgBox(sRes & sMes, vbOKCancel + vbQuestion _
, "Click (OK) to start the Backup!")
If iBut <> vbOK Then Wscript.Quit
End If
'''' for debugging only:
Wscript.Quit '''' for debugging only:
'''' for debugging only:
Set objFSO = CreateObject("Scripting.FileSystemObject")
CopyFolderStructure strSourceFolder, strDestFolder, strExclusion
'''''' and so on...
I am looking to move files from my file server to a tape drive to save space. I need a script that will allow me to move all the files that were accessed 3 years ago or later while still keeping their folder structure.
E.g. d:\share\it\test.txt -> d:\archive\share\it\test.txt, assuming the test.txt file hasn't been accessed in 3 years
I will then run a tape backup over this folder.
I have some scripts that I have been using. The most effective one I have used is this one, but tt doesn't recreate the file structure in the test folder :
Dim objFSO, ofolder, objStream, strSafeDate, strSafeTime, strDateTime, strLogFileName
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objNet = CreateObject("WScript.NetWork")
Set FSO = CreateObject("Scripting.FileSystemObject")
strSafeDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)
strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
Set strDateTime equal to a string representation of the current date and time, for use as part of a valid Windows filename
strDateTime = strSafeDate & "-" & strSafeTime
'Assemble the path and filename
strLogFileName ="Move File " & strDateTime & ".txt"
set outfile = fso.createtextfile(strLogFileName,true)
SPath = "I:\Tech Docs"
Sdest = "I:\Test\"
ShowSubfolders FSO.GetFolder(spath)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
CheckFolder(subfolder)
ShowSubFolders Subfolder
Next
End Sub
'CheckFolder(objFSO.getFolder(SPath))
Sub CheckFolder(objCurrentFolder)
Dim strTempL, strTempR, strSearchL, strSearchR, objNewFolder, objFile
Const OverwriteExisting = TRUE
currDate = Date
dtmDate = DateAdd("d",-0,Now)
strTargetDate = ConvDate(dtmDate)
For Each objFile In objCurrentFolder.Files
FileName = objFile
'WScript.Echo FileName
'strDate = ConvDate(objFile.DateCreated)
strDate = ConvDate(objFile.DateLastAccessed)
If strDate < strTargetDate Then
objFSO.MoveFile FileName, Sdest
outfile.writeline Filename
End If
Next
End Sub
Function ConvDate (sDate) 'Converts MM/DD/YYYY HH:MM:SS to string YYYYMMDD
strModifyDay = day(sDate)
If len(strModifyDay) < 2 Then
strModifyDay = "0" & strModifyDay
End If
strModifyMonth = Month(sDate)
If len(strModifyMonth) < 2 Then
strModifyMonth = "0" & strModifyMonth
End If
strModifyYear = Year(sDate)
ConvDate = strModifyYear & strModifyMonth & strModifyDay
End Function
`
Dim objFSO, ofolder, objStream, strSafeDate, strSafeTime, strDateTime, strLogFileName
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("scripting.filesystemobject")
Set objNet = CreateObject("WScript.NetWork")
Set FSO = CreateObject("Scripting.FileSystemObject")
strSafeDate = DatePart("yyyy",Date) & Right("0" & DatePart("m",Date), 2) & Right("0" & DatePart("d",Date), 2)
strSafeTime = Right("0" & Hour(Now), 2) & Right("0" & Minute(Now), 2) & Right("0" & Second(Now), 2)
Set strDateTime equal to a string representation of the current date and time, for use as part of a valid Windows filename
strDateTime = strSafeDate & "-" & strSafeTime
'Assemble the path and filename
strLogFileName ="Move File " & strDateTime & ".txt"
set outfile = fso.createtextfile(strLogFileName,true)
SPath = "I:\Tech Docs\"
Sdest = "I:\Test\"
ShowSubfolders FSO.GetFolder(spath)
Sub ShowSubFolders(Folder)
CheckFolder Folder
For Each Subfolder in Folder.SubFolders
ShowSubFolders Subfolder
Next
End Sub
'CheckFolder(objFSO.getFolder(SPath))
Sub CheckFolder(objCurrentFolder)
Dim strTempL, strTempR, strSearchL, strSearchR, objNewFolder, objFile
Const OverwriteExisting = TRUE
currDate = Date
dtmDate = DateAdd("d",-0,Now)
strTargetDate = ConvDate(dtmDate)
For Each objFile In objCurrentFolder.Files
'Since we want to preserve the path, we've got to reconstruct it
sAbsPath = objFile.Path
'Swap source and destination in the path, and strip the file name
'from the path.
sNewPath = Replace(Replace(sAbsPath,sPath,Sdest),"\" & objFile.Name,"")
'Here we reconstruct the path if it doesn't exist in the
'destination with our new Sub "MakeDir"
MakeDir sNewPath
FileName = objFile
'WScript.Echo FileName
'strDate = ConvDate(objFile.DateCreated)
strDate = ConvDate(objFile.DateLastAccessed)
If strDate =< strTargetDate Then
'Finally we copy the file to the sNewPath
objFSO.MoveFile FileName, sNewPath & "\"
outfile.writeline Filename
End If
Next
End Sub
Sub MakeDir(strPath)
On Error Resume Next
strParentPath = objFSO.GetParentFolderName(strPath)
If Not objFSO.FolderExists(strParentPath) Then MakeDir strParentPath
If Not objFSO.FolderExists(strPath) Then objFSO.CreateFolder strPath
On Error Goto 0
End Sub
Function ConvDate (sDate) 'Converts MM/DD/YYYY HH:MM:SS to string YYYYMMDD
strModifyDay = day(sDate)
If len(strModifyDay) < 2 Then
strModifyDay = "0" & strModifyDay
End If
strModifyMonth = Month(sDate)
If len(strModifyMonth) < 2 Then
strModifyMonth = "0" & strModifyMonth
End If
strModifyYear = Year(sDate)
ConvDate = strModifyYear & strModifyMonth & strModifyDay
End Function