J'utilise un script qui permet l'envoi de mail en automatique après qu'une application spécifique se soit terminée.
Tout fonctionne très bien mais.... ;-)
En gros:
2 répertoires sur le disque sont crées "A transmettre" et "Archives".
Les documents se situant dans le 1er répertoire sont envoyés par mail puis déplacés dans "Archives" si aucunes erreurs n'est relevées.
Ensuite le résultat "qu'il soit bon ou mauvais" s'inscrit dans un fichier log.txt
Exemple de ce qui est noté dans le log:
INFO - Lancement du programme TrtScanTst
INFO - Envoi du fichier NomDeLaPieceJointe.pdf par email
INFO - Déplacement du fichier C:\A transmettre\NomDeLaPieceJointe.pdf dans C:\Archives
INFO - Fin du programme TrtScanTst
Ou
INFO - Lancement du programme TrtScanTst
ERREUR - Echec de l'envoi du fichier C:\.... N°Erreur 0Xetc bla bla bla le fichier est trop volumineux.
Ce que je voudrais faire:
Lorsque que je rencontre une erreur du type "Fichier trop volumineux"
Un mail me soit adressé sur une autre adresse "secours" que c'elle inscrite dans le xml
"Par exemple mise directement dans le script"
Biensur sans la pièce jointe, ce qui me permettrai de savoir qui à essayé de m'envoyer un mail.
Si quelqu'un a une idée je suis preneur.
Merci d'avance.
Voici le script :
' ############################################################################
' # Nom du script : TrtScanTst.vbs #
' # Commentaires : Script permettant l'envoi #
' ############################################################################
Const version = "0.3"
' Variables globales
Dim fLog, oFSO
' Envoi d'une information dans le fichier log
Sub Log(sMessage)
sDay = Day(Now)
if (len(sDay)=1) Then
sDay = "0" & sDay
End if
sMonth = Month(Now)
if (len(sMonth)=1) Then
sMonth = "0" & sMonth
End if
sHour = Hour(Now)
if (len(sHour)=1) Then
sHour = "0" & sHour
End if
sMinute = Minute(Now)
if (len(sMinute)=1) Then
sMinute = "0" & sMinute
End if
sSecond = Second(Now)
if (len(sSecond)=1) Then
sSecond = "0" & sSecond
End if
sTrace = sDay & "/"& sMonth & "/"& Year(Now) & " " & sHour & ":" & sMinute & ":" & sSecond & " : " & sMessage
fLog.write(sTrace & vbcrlf )
End Sub
Function TesterEnvironnement(sRepRacine)
on error resume next
Dim xmlDocument, ofs, oMessage
' Possibilité de créer les objets dont on va avoir besoin ?
Set xmlDocument = CreateObject("Microsoft.XMLDOM")
if (xmlDocument is Nothing) Then
Log("ERREUR - Problème d'environnement Windows. Impossible de créer un objet de type Microsoft.XMLDOM")
TesterEnvironnement = False
Exit Function
End If
Set ofs = CreateObject("Scripting.FileSystemObject")
if (ofs is Nothing) Then
Log("ERREUR - Problème d'environnement Windows. Impossible de créer un objet de type Scripting.FileSystemObject")
TesterEnvironnement = False
Exit Function
End If
Set oMessage = CreateObject("CDO.Message")
if (oMessage is Nothing) Then
Log("ERREUR - Problème d'environnement Windows. Impossible de créer un objet de type CDO.Message")
TesterEnvironnement = False
Exit Function
End If
' Tester l'existence des répertoires
bOk = ofs.FolderExists(sRepRacine+"\XXX")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Outils")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Installation")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CM")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CM\A transmettre")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CM\Archives")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CD")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CD\A transmettre")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CD\Archives")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CM")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CM\A traiter")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\CM\Archives")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\BR")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\BR\A transmettre")
bOk = bOk And ofs.FolderExists(sRepRacine+"\XXX\Documents\BR\Archives")
if (bOk=False) Then
Log("ERREUR - Les répertoires ne sont pas corrects")
TesterEnvironnement = False
Exit Function
End if
' Tester l'existence du fichier TrtScanTrt.xml
bOk = ofs.FileExists(sRepRacine+"\XXX\Outils\TrtScanTst.xml")
if (bOk=False) Then
Log("ERREUR - Le fichier TrtScanTrt.xml n'existe pas")
TesterEnvironnement = False
Exit Function
End if
' RAZ des objets
Set xmlDocument = Nothing
Set ofs = Nothing
Set oMessage = Nothing
TesterEnvironnement = True
End Function
Function EnvoyerMailEtDeplacerFichier(sCheminFichier, sNomFichier, sCheminFichierArchive, sServeurSmtp, sPort, sFrom, sTo, sEnvoiEmail, sSujetEmail, sContenuEmail)
on error resume next
if ( (sEnvoiEmail="Oui") Or (sEnvoiEmail="oui") Or (sEnvoiEmail="OUI")) Then
Set oMessage = CreateObject("CDO.Message")
oMessage.Subject = sSujetEmail
oMessage.From = sFrom
oMessage.To = sTo
oMessage.TextBody = sContenuEmail
oMessage.AddAttachment sCheminFichier
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = sServeurSmtp
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = Int(sPort)
oMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 500
oMessage.Configuration.Fields.Update
oMessage.Send
If (Err.Number=0) Then
Log ("INFO - Envoi du fichier " & sNomFichier & " par email")
Else
Log("ERREUR - Impossible d'envoyer un email. Message d'erreur : Numéro=" & Err.Number & " libellé=" & Err.Description)
EnvoyerMailEtDeplacerFichier = False
Exit Function
End if
Set oMessage = Nothing
End If
' Déplacement du fichier dans le répertoire d'archives
oFSO.MoveFile sCheminFichier,sCheminFichierArchive
Log ("INFO - Déplacement du fichier " & sCheminFichier & " dans " & sCheminFichierArchive)
EnvoyerMailEtDeplacerFichier = True
End Function
Sub TrtScanTst
' On error resume next
Set oFSO = CreateObject("Scripting.FileSystemObject")
' Dans quel répertoire est situé le programme ?
sRepRacine = oFSO.GetParentFolderName(oFSO.GetParentFolderName(oFSO.GetParentFolderName(Wscript.ScriptFullName)))
If (sRepRacine="") Then
sRepRacine="C:"
End if
' Ouverture du fichier log
Const ForAppending = 8
sRepFichierLog = sRepRacine+"\XXX\Outils"
If (oFSO.FolderExists(sRepFichierLog)=False) Then
sRepFichierLog = "C:\"
End if
sCheminFichierLog = sRepFichierLog & "\TrtScanTst.txt"
If (oFSO.FileExists(sCheminFichierLog)=True) Then
Set fLog = oFSO.OpenTextFile(sCheminFichierLog, ForAppending)
Else
Set fLog = oFSO.CreateTextFile(sCheminFichierLog,False)
End if
Log("INFO - Lancement du programme TrtScanTst")
' Test de l'environnement
' -----------------------
If (TesterEnvironnement(sRepRacine)=False) Then
' On arrête tout
WScript.Quit()
End if
' Lecture du fichier de configuration xml
' ---------------------------------------
Dim xmlDoc, oElement
Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.async = "false"
sCheminFichierXml = sRepFichierLog & "\TrtScanTst.xml"
xmlDoc.load(sCheminFichierXml)
For Each oElement In xmlDoc.getElementsByTagName("Parametres")
sNumeroFiness = oElement.getAttribute("numero_finess")
sServeurSmtp = oElement.getAttribute("smtp")
sPortSmtp = oElement.getAttribute("port")
sFrom = oElement.getAttribute("from")
sTo = oElement.getAttribute("to")
Next
For Each oElement In xmlDoc.getElementsByTagName("CM")
sEnvoiEmailCM = oElement.getAttribute("envoi_email")
sSujetEmailCM = oElement.getAttribute("sujet_email")
sSujetEmailCM = Replace(sSujetEmailCM,"%numero_finess%",sNumeroFiness)
sContenuEmailCM = oElement.getAttribute("contenu_email")
sContenuEmailCM = Replace(sContenuEmailCM,"%numero_finess%",sNumeroFiness)
Next
For Each oElement In xmlDoc.getElementsByTagName("CM")
sEnvoiEmailCM = oElement.getAttribute("envoi_email")
sSujetEmailCM = oElement.getAttribute("sujet_email")
sSujetEmailCM = Replace(sSujetEmailCM,"%numero_finess%",sNumeroFiness)
sContenuEmailCM = oElement.getAttribute("contenu_email")
sContenuEmailCM = Replace(sContenuEmailCM,"%numero_finess%",sNumeroFiness)
Next
For Each oElement In xmlDoc.getElementsByTagName("Courriers")
sEnvoiEmailCourriers = oElement.getAttribute("envoi_email")
sSujetEmailCourriers = oElement.getAttribute("sujet_email")
sSujetEmailCourriers = Replace(sSujetEmailCourriers,"%numero_finess%",sNumeroFiness)
sContenuEmailCourriers = oElement.getAttribute("contenu_email")
sContenuEmailCourriers = Replace(sContenuEmailCourriers,"%numero_finess%",sNumeroFiness)
Next
For Each oElement In xmlDoc.getElementsByTagName("BR")
sEnvoiEmailBordereaux = oElement.getAttribute("envoi_email")
sSujetEmailBordereaux = oElement.getAttribute("sujet_email")
sSujetEmailBordereaux = Replace(sSujetEmailBordereaux,"%numero_finess%",sNumeroFiness)
sContenuEmailBordereaux = oElement.getAttribute("contenu_email")
sContenuEmailBordereaux = Replace(sContenuEmailBordereaux,"%numero_finess%",sNumeroFiness)
Next
' Parcours des cm à transmettre
' -------------------------------------------
Dim fich
For each fich in oFSO.GetFolder(sRepRacine+"\XXX\Documents\CMutuelles\A transmettre").Files
EnvoyerMailEtDeplacerFichier fich.Path, fich.Name, sRepRacine+"\XXX\Documents\CM\Archives\" + fich.Name, sServeurSmtp, sPortSmtp, sFrom, sTo, sEnvoiEmailCM, sSujetEmailCM, sContenuEmailCM
Next
' Parcours des courriers divers à transmettre
' -------------------------------------------
For each fich in oFSO.GetFolder(sRepRacine+"\XXX\Documents\Courriers divers\A transmettre").Files
EnvoyerMailEtDeplacerFichier fich.Path, fich.Name, sRepRacine+"\XXX\Documents\Courriers divers\Archives\" + fich.Name, sServeurSmtp, sPortSmtp, sFrom, sTo, sEnvoiEmailCourriers, sSujetEmailCourriers, sContenuEmailCourriers
Next
' Parcours des BR à archiver
' ------------------------------------------------
For each fich in oFSO.GetFolder(sRepRacine+"\XXX\Documents\BR\A transmettre").Files
EnvoyerMailEtDeplacerFichier fich.Path, fich.Name, sRepRacine+"\XXX\Documents\BR\Archives\" + fich.Name, sServeurSmtp, sPortSmtp, sFrom, sTo, sEnvoiEmailBordereaux, sSujetEmailBordereaux, sContenuEmailBordereaux
Next
' Purge des données présentes dans le répertoire d'archivage
' ----------------------------------------------------------
Log("INFO - Fin du programme TrtScanTst")
Set oFSO = Nothing
set xmlDoc = Nothing
End Sub
' Début du programme
' ==================
wscript.echo("STF/TrtScanTst - Version " & version)
TrtScanTst
