folder monitor

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


 End Function