1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. Visual Basic 6
Sujet Précédent Sujet Suivant

[DEPLACE] Envoi de mail automatique

Résolu
Fredva69 Messages postés 10 Date d'inscription mardi 21 juin 2011 Statut Membre Dernière intervention 15 novembre 2011 - 21 juin 2011 à 17:11
Fredva69 Messages postés 10 Date d'inscription mardi 21 juin 2011 Statut Membre Dernière intervention 15 novembre 2011 - 15 nov. 2011 à 10:22
Bonjour,

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.
Si pour X raisons le mail ne peut partir alors le fichier n'est pas déplacé.

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:

Si ok:
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 si non ok

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

Dim oMessage

' MsgBox("sCheminFichier=" & sCheminFichier)
' MsgBox("sNomFichier=" & sNomFichier)
' MsgBox("sCheminFichierArchive=" & sCheminFichierArchive)
' MsgBox("sServeurSmtp=" & sServeurSmtp)
' MsgBox("sPort=" & sPort)
' MsgBox("sFrom=" & sFrom)
' MsgBox("sTo=" & sTo)
' MsgBox("sEnvoiEmail=" & sEnvoiEmail)
' MsgBox("sCheminFichier=" & sCheminFichier)
' MsgBox("sSujetEmail=" & sSujetEmail)
' MsgBox("sContenuEmail=" & sContenuEmail)

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






Voici le XML :

<?xml version="1.0" encoding="ISO-8859-1"?>
<TrtScanTst>

<CM envoi_email="non"
sujet_email="%numero_finess%"
contenu_email="Pour Archivage" />
<Courriers envoi_email="Oui"
sujet_email="%numero_finess%"
contenu_email="Envoi de courriers" />

</TrtScanTst>
A voir également:

7 réponses

Réponse 1 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 220
22 juin 2011 à 16:11
alors merci de ne plus m'en laisser.

D'avance merci

Message prfaitement reçu ===>> je t'en fais donc la promesse.

____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
3
Réponse 2 / 7
Fredva69 Messages postés 10 Date d'inscription mardi 21 juin 2011 Statut Membre Dernière intervention 15 novembre 2011
22 juin 2011 à 16:23
Merci
3
Réponse 3 / 7
Fredva69 Messages postés 10 Date d'inscription mardi 21 juin 2011 Statut Membre Dernière intervention 15 novembre 2011
21 juin 2011 à 17:12
Désolé je me suis trompé je l'ai mis au bar "surement une habitude ;-)
0
Réponse 4 / 7
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 220
22 juin 2011 à 10:46
Bonjour,

Tiens ! Un autre adepte de la non-indentation ou de la non utilisation des balises code.
Je me refuse à analyser ce script.


____________________
Vous aimez Codes-Sources ? Il vous aide ? Cliquez ici pour l'aider à continuer
Cliquer sur "Réponse acceptée" en bas d'une solution adéquate est
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 7
Fredva69 Messages postés 10 Date d'inscription mardi 21 juin 2011 Statut Membre Dernière intervention 15 novembre 2011
22 juin 2011 à 11:07
Une ame plus charitable ?
0
Réponse 6 / 7
Fredva69 Messages postés 10 Date d'inscription mardi 21 juin 2011 Statut Membre Dernière intervention 15 novembre 2011
22 juin 2011 à 15:49
Je vais te répondre à la "ucfoutu" vu ce que j'ai pu lire de tes commentaires sur moultes sujets, "la plupart pour le moins agréable" "irronie biensur"
Te citant:

"adepte de la non-indentation ou de la non utilisation des balises code."

Je cherche de l'aide pas des critiques...(ou autre vu l'adepte des jeux de mots).

Perso que tu refuses d'analyser le script n'a rien d'etonnant, imagine l'inverse tu l'analyses, hey hop 12 000 questions qui ne servent en rien à faire avancer les choses a part pourquoi ci pourquoi ca.

Pour ma part je souhaite des commentaires constructifs :
ex: Pourquoi n'as tu pas utiliser les balises code et bla bla bla...

Bref je sais que tu n'acceptes pas la critique, vu toujours les commentaires que j'ai pu lire ici, alors merci de ne plus m'en laisser.

D'avance merci
0
Réponse 7 / 7
Fredva69 Messages postés 10 Date d'inscription mardi 21 juin 2011 Statut Membre Dernière intervention 15 novembre 2011
15 nov. 2011 à 10:22
[^^sad1]
0
Rejoignez-nous