Don't like ads? PRO users don't see any ads ;-)
Public Pastes
Guest

folder monitor

By: a guest on Nov 15th, 2012  |  syntax: VB.NET  |  size: 3.44 KB  |  hits: 187  |  expires: Never
download  |  raw  |  embed  |  report abuse  |  print
Text below is selected. Please press Ctrl+C to copy to your clipboard. (⌘+C on Mac)
  1. Option Explicit
  2.  
  3. Dim  objMessage, objFile, colFiles, objHotfolder, intNOF, EmailTo, Message, strComputer, objWMIService
  4. Dim strOriginalTimestamp, WMIDateStringToDate, intDifference, strFolderPath, intFileGreaterCount, strFileName
  5.  
  6.  
  7.  
  8.  
  9.  
  10.  
  11.  
  12. Set objMessage = CreateObject("cdo.message")
  13.  
  14.  
  15.  
  16. ScanFolder("'\\york_production\\production\\pageflow\\system\\FTP\\Error\\A\\'") 'test scanfolders
  17.  
  18.  
  19.  
  20. Set objMessage = Nothing
  21. Set objWMIService = Nothing
  22. Set colFiles = Nothing
  23.  
  24. '=====================================================================================================================================================================================================================================================
  25. 'function to email using posrt 25 of mail server
  26. Function SendEmail (EmailTo , Message)
  27.  
  28. objMessage.subject = "Warning, Files Have Failed in Transit"
  29. objMessage.from = "FTP@yk-futureproof1"
  30. objMessage.to = EmailTo
  31. objMessage.Textbody = Message
  32.  
  33. 'send using specific port
  34. objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  35.  
  36. 'smtp server
  37. objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail relay server"
  38.  
  39. 'Set server port
  40. objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  41.  
  42. objMessage.Configuration.Fields.Update
  43. objMessage.Send
  44. End Function
  45.  
  46. '=======================================================================================================================================================================================================================================================
  47. 'function to scan hot folders
  48. Function ScanFolder (objHotFolder)
  49.  
  50. 'strFolderPath = "E:" & Replace(objHotFolder,chr(39),"") 'add c: and remove the apostraphie in the file path
  51.  
  52.  
  53. strComputer = "."              
  54. intNOF = 0
  55. strOriginalTimestamp = 0
  56. WMIDateStringToDate = 0
  57. intFileGreaterCount = 0
  58. strFileName = ""
  59.  
  60. ' wmi query to get all the files in objfolder
  61. Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
  62. Set colFiles = objWMIService.ExecQuery _
  63.         ("SELECT * FROM CIM_DataFile WHERE Drive = 'E:'" & _
  64.         "AND path =" & objHotFolder)
  65.  
  66.  
  67.  
  68. For Each objFile in colFiles
  69.     strOriginalTimestamp = objFile.LastAccessed 'gather the last accesed timestamp for all files
  70.        
  71.        
  72.        
  73.         'convert the last accessed date to normal date for calculations
  74.         WMIDateStringToDate = CDate(Mid(strOriginalTimestamp, 7, 2) & "/" & _
  75.      Mid(strOriginalTimestamp, 5, 2) & "/" & Left(strOriginalTimestamp, 4) _
  76.          & " " & Mid (strOriginalTimestamp, 9, 2) & ":" & _    
  77.              Mid(strOriginalTimestamp, 11, 2) & ":" & Mid(strOriginalTimestamp, _
  78.                  13, 2))
  79.        
  80.        
  81.         'work out the difference between that date and now in mins
  82.         intDifference = datediff("n",WMIDateStringToDate,NOW )         
  83.  
  84.        
  85.         If intDifference < 5 Then
  86.         strFileName = strFileName & " " & vbcrlf & objfile.filename & " "
  87.         intFileGreaterCount = intFileGreaterCount + 1
  88.        
  89.                                
  90.         End if
  91.        
  92.        
  93. Next
  94.  
  95.  
  96.         If intFileGreaterCount >= 1 then
  97.                                 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"_
  98.                                 & " Please contact Systems. The name of the file or files rejected are " & vbcrlf & strFileName & vbcrlf & vbcrlf  
  99.  
  100.                                
  101.                                
  102.                                
  103.         End If
  104.  
  105.  
  106.  End Function
create a new version of this paste RAW Paste Data