1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
| Option Explicit
Dim objArrayList
Set objArrayList = CreateObject("System.Collections.ArrayList")
Call CheckFiles("D:\Test\","AC","EDI",30)
If objArrayList.Count <> 0 Then Call SendMail()
Set objArrayList = Nothing
'#############################################################
Sub CheckFiles(argPath,argFile,argExt,argTime)
Dim objFso, objFile
Set objFso = CreateObject("Scripting.FileSystemObject")
If objFso.FolderExists(argPath) Then
For Each objFile In objFso.GetFolder(argPath).Files
If DateDiff("n", objFile.DateLastModified, Now) < argTime And _
Left(objFile.Name,2) = argFile And _
UCase(objFso.GetExtensionName(objFile.Name)) = argExt Then
WScript.Quit
Else
objArrayList.Add objFile.DateLastModified & Space(3) & objFile.Path
End If
Next
End If
objArrayList.Sort
objArrayList.Reverse
Set objFso = Nothing
End Sub
'#############################################################
Sub SendMail()
Dim strBody
strBody = "Bonjour," & Chr(13) & Chr(13) &_
"Une potentielle erreur de traitement dans l'integration " &_
"des commandes a ete detectee." & Chr(13) &_
"Il semblerait qu'il n'y ait pas eu d'integration de commandes " &_
"depuis plus de 30 minutes." & Chr(13) &_
"Hors le traitement a lieu toutes les demi-heure." & Chr(13) & Chr(13) &_
"Le fichier le plus recent sur " &_
"D:\Test est :" & Chr(13) & objArrayList(0) & Chr(13) & Chr(13) & "Cordialement"
With CreateObject("CDO.Message")
.From = "integration@mon-entreprise.com"
.To = "mon-mail@mon-entreprise.com"
.CC = ""
.Subject = "Erreur d'integration des commandes AC sur le serveur"
.TextBody= strBody
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mon-entrepise.com"
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
On Error Resume Next
.Send
'If Err.Number <> 0 Then MsgBox Err.Description,16,"Erreur"
On Error GoTo 0
End With
End Sub |
Partager