FamousMortimer
asked on
VBS Compare Folder to Itself last time script was run
Hi Experts,
I am looking to create a script that will take a source folder and recursively compare the current contents of that folder to the contents last time this script ran. It can store the folder/file contents in a text file, then compare the contents, then rewrite the text file with the new contents.
I need the output to be a list of all the recently added or modified files in a format like so:
C:\test\doc1.txt
C:\test\temp\doc5.txt
Any help is greatly appreciated. Let me know if you have any question or need me to clarify
I am looking to create a script that will take a source folder and recursively compare the current contents of that folder to the contents last time this script ran. It can store the folder/file contents in a text file, then compare the contents, then rewrite the text file with the new contents.
I need the output to be a list of all the recently added or modified files in a format like so:
C:\test\doc1.txt
C:\test\temp\doc5.txt
Any help is greatly appreciated. Let me know if you have any question or need me to clarify
Hi, check out this script. I think it will suit better.
https://www.experts-exchange.com/questions/26609153/Help-needed-with-VBScript-edit.html
The only thing it's not recursive so it won't do subfolders just yet, but I can modify for you if you would like me to.
Regards,
Rob.
https://www.experts-exchange.com/questions/26609153/Help-needed-with-VBScript-edit.html
The only thing it's not recursive so it won't do subfolders just yet, but I can modify for you if you would like me to.
Regards,
Rob.
ASKER
Thanks for the reply, I am going to check it out now. I'll let you know.
ASKER
First off, I gotta say this is a sweet script! Whether I needed this or not atm, this is one to add to the archives.
I do need it to recurse through the sub folder though. If you can help me with that, I would be eternally grateful :)
Also, I changed lines 33, 63 to refer to the full file path... (i.e. replaced objFile.Name with objFile.Path)
Thanks,
Jeremy
I do need it to recurse through the sub folder though. If you can help me with that, I would be eternally grateful :)
Also, I changed lines 33, 63 to refer to the full file path... (i.e. replaced objFile.Name with objFile.Path)
Thanks,
Jeremy
OK, I'll get on it at some stage tonight.
Rob.
Rob.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
EXCELLENT!
I modified it a bit to suit my application in case anyone needs the same as I.
Basically I gave the option to choose what to monitor (Created, Deleted, etc.). Instead of creating a report, it will send an HTML email to recipients with the changes and will use a UNC path instead of a local path if it is on a remote server. In the case of an error i will send an email to yourself with the error details.
Keep in mind that on Windows 7/2008 you will have to enable Last Access date
I modified it a bit to suit my application in case anyone needs the same as I.
Basically I gave the option to choose what to monitor (Created, Deleted, etc.). Instead of creating a report, it will send an HTML email to recipients with the changes and will use a UNC path instead of a local path if it is on a remote server. In the case of an error i will send an email to yourself with the error details.
Keep in mind that on Windows 7/2008 you will have to enable Last Access date
Option Explicit
Dim strFolder
Dim strList
Dim strName
Dim strHTMLName
Dim strLocalDir
Dim strUNCPath
Dim strEmailTo
Dim strEmailFrom
Dim strEmailSubj
Dim strEmailBody
Dim strSMTPServer
Dim objList
Dim objOldFiles
Dim objFSO
Dim objFile
Dim objFolder
Dim objSubFolder
Dim dtmCreated
Dim dtmModified
Dim dtmAccessed
Dim dtmPrevCreated
Dim dtmPrevModified
Dim dtmPrevAccessed
Dim bMonitorCreated
Dim bMonitorOverwritten
Dim bMonitorModified
Dim bMonitorAccessed
Dim bMonitorDeleted
Dim bHeaderAdded
Dim arrLine
Dim MailErr
On Error Resume Next
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
'----------------------------------------------------------
'-------------------EDIT VARIABLES HERE--------------------
'----------------------------------------------------------
bMonitorCreated = True '||
bMonitorOverwritten = True '||
bMonitorModified = True '||
bMonitorAccessed = False '||
bMonitorDeleted = True '||
'||
strEmailSubj = "New FTP Files" '||
strEmailTo = "me@company.com" '||
strEmailFrom = "FTPServer@cclind.com" '||
strSMTPServer = "ip.add.re.ss" '||
strUNCPath = "\\UNC\Path\To\Files" '||
strFolder = "C:\test\" '||
strList = "all_files.txt" '||
'----------------------------------------------------------
'----------------------------------------------------------
If Right(strFolder, 1) <> "\" Then strFolder = strFolder & "\"
If Right(strUNCPath, 1) <> "\" Then strUNCPath = strUNCPath & "\"
Set objOldFiles = CreateObject("Scripting.Dictionary")
objOldFiles.CompareMode = VbTextCompare
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(strList) Then
Set objList = objFSO.OpenTextFile(strList, ForReading)
Do Until objList.AtEndOfStream
arrLine = Split(objList.ReadLine, vbTab)
objOldFiles.Add LCase(arrLine(0)), arrLine(1)
Loop
objList.Close
End If
Set objList = objFSO.CreateTextFile(strList, True)
Set objFolder = objFSO.GetFolder(strFolder)
RecurseFolder strFolder
'check for deleted files
For Each strName In objOldFiles
If bMonitorDeleted And objFSO.FileExists(strName) = False Then _
strEmailBody = strEmailBody & "<dd><b>Deleted:</b> <a href=" & Chr(34) & strHTMLName & Chr(34) & _
">" & Replace(strHTMLName, "File:///", "") & "</a> on " & dtmCreated & "</dd><br>"
Next
If strEmailBody <> vbNullString Then
strEmailBody = "The following change(s) have been made:" & strEmailBody
MailErr = SendEmail(strEmailTo, strEmailFrom, strEmailSubj, strEmailBody, strSMTPServer)
End If
objList.Close
If Err.Number <> 0 or MailErr <> 0 Then
SendEmail "me@company.com; you@company.com", _
"FTPScriptError@cclind.com", _
"FTP Monitor Scripting Error", _
"<b>Error Num.: </b>" & Err.Number & "<br>" & _
"<b>Error Desc.: </b>" & Err.Description & "<br>" & _
"<b>Error Src.: </b>" & Err.Source, _
strSMTPServer
Err.Clear
End If
Set objList = Nothing
Set objOldFiles = Nothing
Set objFSO = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objSubFolder = Nothing
Sub RecurseFolder(strFolderPath)
For Each objFile In objFSO.GetFolder(strFolderPath).Files
strName = objFile.Path
strHTMLName = "File:///" & Replace(strName, strFolder, strUNCPath, 1, -1, 1)
dtmCreated = objFile.DateCreated
dtmModified = objFile.DateLastModified
dtmAccessed = objFile.DateLastAccessed
objList.WriteLine strName & vbTab & dtmCreated & ";" & dtmModified & ";" & dtmAccessed
'check for new files
If bMonitorCreated And objOldFiles.Exists(LCase(strName)) = False Then
If bHeaderAdded = False Then
Call AddSubFolderHeader(objSubFolder.Name)
bHeaderAdded = True
End If
strEmailBody = strEmailBody & "<dd><b>Created:</b> <a href=" & Chr(34) & strHTMLName & Chr(34) & _
">" & Replace(strHTMLName, "File:///", "") & "</a> on " & dtmCreated & "</dd><br>"
Else
dtmPrevCreated = Split(objOldFiles(LCase(strName)), ";")(0)
dtmPrevModified = Split(objOldFiles(LCase(strName)), ";")(1)
dtmPrevAccessed = Split(objOldFiles(LCase(strName)), ";")(2)
'check for changes to files
If bMonitorOverwritten And CDate(dtmCreated) > CDate(dtmPrevCreated) Then
If bHeaderAdded = False Then
Call AddSubFolderHeader(objSubFolder.Name)
bHeaderAdded = True
End If
StrEmailBody = strEmailBody & "<dd><b>Overwritten:</b> <a href=" & Chr(34) & strHTMLName & Chr(34) & _
">" & Replace(strHTMLName, "File:///", "") & "</a> on " & dtmCreated & "</dd><br>"
ElseIf bMonitorModified And CDate(dtmModified) > CDate(dtmPrevModified) Then
If bHeaderAdded = False Then
Call AddSubFolderHeader(objSubFolder.Name)
bHeaderAdded = True
End If
StrEmailBody = strEmailBody & "<dd><b>Modified:</b> <a href=" & Chr(34) & strHTMLName & Chr(34) & _
">" & Replace(strHTMLName, "File:///", "") & "</a> on " & dtmCreated & "</dd><br>"
ElseIf bMonitorAccessed And CDate(dtmAccessed) > CDate(dtmPrevAccessed) Then
If bHeaderAdded = False Then
Call AddSubFolderHeader(objSubFolder.Name)
bHeaderAdded = True
End If
StrEmailBody = strEmailBody & "<dd><b>Accessed:</b> <a href=" & Chr(34) & strHTMLName & Chr(34) & _
">" & Replace(strHTMLName, "File:///", "") & "</a> on " & dtmCreated & "</dd><br>"
End If
End If
Next
For Each objSubFolder In objFSO.GetFolder(strFolderPath).SubFolders
bHeaderAdded = False
RecurseFolder objSubFolder.Path
Next
End Sub
Sub AddSubFolderHeader(strSubFolderName)
strEmailBody = strEmailBody & "<br><br><b>-----" & strSubFolderName & "-----</b><br>"
End Sub
Function SendEmail(sTo, sFrom, sSubj, sBody, sSMTPServer)
Dim objMessage
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
Set objMessage = CreateObject("CDO.Message")
With objMessage
.From = sFrom
.To = sTo
.Subject = sSubj
.HTMLBody = sBody
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoAnonymous
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Configuration.Fields.Update
.Send
End With
SendEmail = Err.Number
Set objMessage = Nothing
End Function
ASKER
This is why I love this site!
Wow, that's more than a slight modification. Nice work.
Thanks for the grade.
Regards,
Rob.
Thanks for the grade.
Regards,
Rob.
ASKER
Open in new window