VBS : Envoi mail sous double condition

Question

Bonjour,

Je fais appel à vous car j'ai un petit problème avec la conception d'un script VBS.
Voilà, j'essaie en fait de concevoir un script VBS qui, via une tache planifiée Windows, check le contenu d'un dossier sur un serveur à intervalles réguliers (toutes les 1 ou 2 heures).
Dans ce dossier, il y a constamment des fichiers de plusieurs types. Je voudrais donc qu'il se concentre sur les fichiers d'un certains types et qu'il contrôle ensuite leur date et heure de modification.

En effet, ces fichiers sont déposés là via un traitement automatisé toutes les 30 minutes. Je désirerais en fait recevoir une alerte mail si tous ces fichiers sont âgés de plus de 30 minutes afin de déceler rapidement si un problème de traitement a eu lieu.

Pour l'instant tout ce que je viens de vous expliquer fonctionne à peu près dans mon script actuel, le seul petit hic c'est que j'utilise la fonction "For Each" et du coup, il m'envoie un mail PAR fichier datant de plus de 30 minutes.... Et comme il existe un nombre important de ces fichiers dans le dossier... Hors je ne voudrais recevoir qu'un seul mail d'alerte par exécution du script...

De plus, je ne sais pas encore comment intégrer ma variable "nomfichier" pour que mon VBS centre son action sur ces seuls fichiers dans le dossier (j'ai essayé de l'ajouter au "If" avec un "And" mais ça ne marche pas).
Mes connaissances en VBS étant relativement limitées, auriez-vous idée de la fonction à utiliser à la place de For Each et aussi de la méthode pour filtrer l'action sur les fichiers nommés "AC*.EDI" ?

Voici le script en question :



strFolder = "D:\Chemin d'accès du dossier"
nomfichier = "AC*.EDI"
Dim objFile
Set objFSO = CreateObject("Scripting.FileSystemObject" )
Set objFolder = objFSO.GetFolder(strFolder)
Set colFiles = objFolder.Files
For Each objFile In colFiles
If DateDiff("N",objFile.DateLastModified,Now()) > 30 Then
With CreateObject("CDO.Message")
.From="Integration@mon-entreprise.com"
.To="service.info@mon-entreprise.com"
.CC=""
.Subject="Erreur d'integration"
.TextBody="Bonjour," & Chr(13) & "Une potentielle erreur de traitement dans l'intégration des commandes été détectée." & Chr(13) & "Il semblerait qu'il n'y ait pas eu d'intégration de commandes depuis plus de 30 minutes. " & Chr(13) & "Cordialement"
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mon-entreprise.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"
End If
On Error GoTo 0
End With
End If
Next

cs_JMO · Answer

Bonjour,

Exemple avec un code indenté:

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 
              objArrayList.Add objFile.DateLastModified & Space(3) & objFile.Path 
           End If
       Next
    End If
    
    Set objFso = Nothing
End Sub
'#############################################################
Sub SendMail()
    Dim arrFiles
    Dim strBody
    Dim i
    
    For i = 0 To objArrayList.Count-1
        arrFiles = arrFiles & objArrayList(i) & vbCr
    Next
   
    strBody = "Bonjour," & Chr(13) &_
              "Une potentielle erreur de traitement dans l'intégration " &_
              "des commandes été détectée." & Chr(13) &_
              "Il semblerait qu'il n'y ait pas eu d'intégration de commandes " &_
              "depuis plus de 30 minutes." & Chr(13) & Chr(13) &_
              "Fichier(s) :" & Chr(13) & arrFiles & Chr(13) & Chr(13) & "Cordialement"

    With CreateObject("CDO.Message")
         .From = "Integration@mon-entreprise.com"
         .To = "service.info@mon-entreprise.com"
         .CC = ""
         .Subject = "Erreur d'integration"
         .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-entreprise.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

jean-marc

YLKweb · Answer

Bonjour,

Tout d'abord un grand merci à toi Jean-Marc pour ta rapidité et ton efficacité !
Ce script est à peu de choses près exactement ce que je cherche !

Il y a juste deux petits détails que j'aurais besoin de modifier si possible.

Le premier concerne le déclenchement de l'alerte par envoi de mail. En effet, je m'étais peut-être mal exprimé (en même temps, c'était plutôt confus je te l'accorde) mais le mail d'alerte ne doit se déclencher que si AUCUN fichier du dossier n'est âgé de moins de 30 minutes, dès le moment où au moins un fichier est âgé d'il y a 30 minutes ou moins, l'alerte ne se déclenche pas.

Dans le script actuel que tu as écris (qui ceci dit est vraiment brillant, je le répète), c'est l'inverse, et dès qu'au moins un fichier est plus vieux que 30 minutes, il envoi un mail, avec en prime le listing du ou des fichier(s) concerné (pas mal cet ajout d'ailleurs).
En fait il faudrait juste inverser la condition ! Saurais-tu me dire comment faire ça ?

Pour ce qui est du deuxième petit détail, il porte justement sur ton ajout (le listing des fichiers).
Comme ce listing n'a pas grand intérêt en l'état (car les fichiers présents sont ceux n'étant pas en erreur en fait puisque bien présents !) et qu'il risque d'être très important (beaucoup de fichiers sont déposés dans ce dossier), j'aimerais savoir si on peut à la rigueur faire apparaitre simplement le fichier le plus récent (le dernier en date et heure à avoir été déposé dans le dossier).
Ça permettrait de se faire une idée plus précise de l'heure à partir de laquelle le traitement n'a plus eu lieu vu que le script ne tournera que toutes les 1 ou 2 heures (en gros savoir si le problème d'intégration date de la dernière demi-heure donc du dernier traitement ou d'il y a déjà une ou deux heures...).

Dis-moi si tu as encore besoin de précisions.

Je te remercie encore de ton aide et de tes compétences dans un domaine que personnellement je ne maitrise pas. Encore chapeau bas !

cs_JMO · Answer

Bonjour YLKweb,

Un tri de l'ArrayList permet d'obtenir



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 
              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) &_
              "Une potentielle erreur de traitement dans l'intégration " &_
              "des commandes été détectée." & Chr(13) &_
              "Il semblerait qu'il n'y ait pas eu d'intégration de commandes " &_
              "depuis plus de 30 minutes." & Chr(13) & Chr(13) &_
              "Dernier fichier créé : " & objArrayList(0) & Chr(13) & Chr(13) & "Cordialement"

    MsgBox strBody,,Now 

End Sub




jean-marc

YLKweb · Answer

Arf... C'est pas loin !

Pour l'affichage du dernier fichier créé, c'est nickel !
Par contre, le coup de l'envoi de mail si aucun fichier de moins de 30 minutes d'ancienneté n'est trouvé dans le dossier, ça marche pas. :(

En fait, là il m'envoie un mail que si il trouve un fichier de moins de 30 minutes... (J'ai vu que tu avais simplement inversé le sens du symbole dans la fonction DateDiff).

En fait, le truc c'est que j'aimerais que le script check tous les fichiers en question dans le dossier.
Pour info, il y a constamment des fichiers anciens dans ce dossier (un autre script se charge de purger le dossier tous les mois seulement donc...). Par contre, si tout se passe bien bien (pas d'erreur de traitement), il y a aussi de nouveaux fichiers qui sont déposés toutes les demi-heure. C'est donc pour ça que j'aimerais que l'alerte mail ne se déclenche QUE s'il ne trouve AUCUN fichier de moins de 30 minutes. S'il en trouve ne serait-ce qu'un seul, pas de mail.
Mais s'il trouve des fichiers de moins de 30 minutes et des fichiers de plus de trente minutes (et ça sera le cas s'il n'y a pas d'anomalie), pas de mail non plus ! C'est là toute la difficulté en fait... :(

A ce niveau là, ton premier script (avec le symbole supérieur en fait) était plus proche. Le seul soucis c'est qu'il envoyait un mail dès qu'il trouvait un fichier plus vieux que 30 minutes, même s'il y avait des fichiers "récents" à côté. Je voudrais qu'il n&#8217;envoie un mail que s'il n'y a exclusivement que des fichiers plus vieux de 30 minutes.

Bref, je me rend compte de la difficulté de la tâche et si c'est pas faisable, pas de soucis. Encore une fois, je te remercie malgré tout de ton implication pour m'aider dans la résolution de mon problème !



P.S : Décidément tu es implacable sur les secrets du VBS, je suis encore ébahi de la rapidité de tes interventions ! :D

YLKweb · Answer

Re !

Après avoir un peu planché sur la question, j'ai finalement trouvé la solution pour régler le dernier petit détail !

Voici le script que cela donne au final :

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

Tout marche nickel !

Encore merci à toi JMO ! Sans ton aide précieuse je n'y serais pas parvenu ! :)

VBS : Envoi mail sous double condition

5 réponses

Votre réponse

Discussions similaires