Skip to content

Instantly share code, notes, and snippets.

@typomedia
Last active December 23, 2015 06:19
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save typomedia/6593343 to your computer and use it in GitHub Desktop.
Save typomedia/6593343 to your computer and use it in GitHub Desktop.
This Visual Basic script sends an email if it finds files in a specific folder or subfolder which are newer than x minutes.
' Copyright 2013 Typomedia Foundation. All rights reserved.
' Released under GPL version 3.
'
' VBS New Files Mailer v1.0
' Send a mail if files of a specific dir are newer than x minutes
Const strPath = "C:\foo\bar" 'or \\SERVER\foo\bar
Const intMin = 120 'Minutes
Set fso = CreateObject("Scripting.FileSystemObject")
Message = GetFiles(strPath)
If Message <> "" then 'if Message is not empty
SendMail(Message)
'MsgBox(Message)
End if
Function SendMail(Message)
Set objEmail = CreateObject("CDO.Message")
objEmail.From = """Windows Server"" <server@domain.tld>"
objEmail.To = "admin@domain.tld"
'objEmail.CC = "someone@domain.tld"
objEmail.Subject = "New Files"
objEmail.HTMLBody = "<html><body><pre>" & Message & "</pre></body></html>"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.provider.tld"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = "server@domain.tld"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "<password>"
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
objEmail.Configuration.Fields.Update
objEmail.Send
End Function
Function GetFiles(strPath)
On Error Resume Next
Set objFolder = fso.GetFolder(strPath)
'Get all Files from folder
For Each objFile In objFolder.Files
fileCreateDate = objFile.DateCreated
'fileModDate = objFile.DateLastModified
'fileAccessDate = objFile.DateLastAccessed
If Err.Number = 0 Then
If DateDiff("n", fileCreateDate, Now) < intMin Then '< newer than
strFiles = strFiles & objFile.Path & vbNewLine
End if
End if
Next
'Get all subfolders
For Each objFolder In objFolder.SubFolders
'Get all Files from subfolder
strFiles = strFiles & GetFiles(objFolder.Path)
Next
GetFiles = strFiles
End Function
@typomedia
Copy link
Author

Thanks to Igor Bauer for helping me with code!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment