Option Explicit

Dim objMessage, objFile, colFiles, objHotfolder, intNOF, EmailTo, Message, strComputer, objWMIService

Dim strOriginalTimestamp, WMIDateStringToDate, intDifference, strFolderPath, intFileGreaterCount, strFileName

Set objMessage = CreateObject ( "cdo.message" )

ScanFolder ( "'\\york_production\\production\\pageflow\\system\\FTP\\Error\\A\\'" ) 'test scanfolders

Set objMessage = Nothing

Set objWMIService = Nothing

Set colFiles = Nothing

'=====================================================================================================================================================================================================================================================

'function to email using posrt 25 of mail server

Function SendEmail ( EmailTo , Message )

objMessage . subject = "Warning, Files Have Failed in Transit"

objMessage . from = "FTP@yk-futureproof1"

objMessage . to = EmailTo

objMessage . Textbody = Message

'send using specific port

objMessage . Configuration . Fields . Item ( "http://schemas.microsoft.com/cdo/configuration/sendusing" ) = 2

'smtp server

objMessage . Configuration . Fields . Item ( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ) = "mail relay server"

'Set server port

objMessage . Configuration . Fields . Item ( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ) = 25

objMessage . Configuration . Fields . Update

objMessage . Send

End Function

'=======================================================================================================================================================================================================================================================

'function to scan hot folders

Function ScanFolder ( objHotFolder )

'strFolderPath = "E:" & Replace(objHotFolder,chr(39),"") 'add c: and remove the apostraphie in the file path

strComputer = "."

intNOF = 0

strOriginalTimestamp = 0

WMIDateStringToDate = 0

intFileGreaterCount = 0

strFileName = ""

' wmi query to get all the files in objfolder

Set objWMIService = GetObject ( "winmgmts:\\" & strComputer & "\root\cimv2" )

Set colFiles = objWMIService . ExecQuery _

( "SELECT * FROM CIM_DataFile WHERE Drive = 'E:'" & _

"AND path =" & objHotFolder )

For Each objFile in colFiles

strOriginalTimestamp = objFile . LastAccessed 'gather the last accesed timestamp for all files

'convert the last accessed date to normal date for calculations

WMIDateStringToDate = CDate ( Mid ( strOriginalTimestamp, 7 , 2 ) & "/" & _

Mid ( strOriginalTimestamp, 5 , 2 ) & "/" & Left ( strOriginalTimestamp, 4 ) _

& " " & Mid ( strOriginalTimestamp, 9 , 2 ) & ":" & _

Mid ( strOriginalTimestamp, 11 , 2 ) & ":" & Mid ( strOriginalTimestamp, _

13 , 2 ) )

'work out the difference between that date and now in mins

intDifference = datediff ( "n" ,WMIDateStringToDate,NOW )

If intDifference < 5 Then

strFileName = strFileName & " " & vbcrlf & objfile . filename & " "

intFileGreaterCount = intFileGreaterCount + 1

End if

Next

If intFileGreaterCount >= 1 then

SendEmail "personemailingto@email.com" , "A Page has failed in the transfer after release in page manager, please send the page again, if this is the second time you receive this message" _

& " Please contact Systems. The name of the file or files rejected are " & vbcrlf & strFileName & vbcrlf & vbcrlf

End If