Problème pour renommer un fichier avant de l'envoyer par mail
mistermail
Messages postés
2
Date d'inscription
jeudi 16 juillet 2009
Statut
Membre
Dernière intervention
4 août 2009
-
31 juil. 2009 à 16:38
mistermail Messages postés 2 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 4 août 2009 - 4 août 2009 à 09:37
mistermail Messages postés 2 Date d'inscription jeudi 16 juillet 2009 Statut Membre Dernière intervention 4 août 2009 - 4 août 2009 à 09:37
A voir également:
- Problème pour renommer un fichier avant de l'envoyer par mail
- Fichier .ini - Conseils pratiques -Visual Basic / VB.NET
- Fichier class ✓ - Forum Java
- Fichier json - Conseils pratiques -Javascript
- Un programme tente d'envoyer un courrier en votre nom - Forum Visual Basic 6
- Renommer une colonne sql server ✓ - Forum SQL
2 réponses
cs_JMO
Messages postés
1854
Date d'inscription
jeudi 23 mai 2002
Statut
Membre
Dernière intervention
24 juin 2018
27
2 août 2009 à 23:27
2 août 2009 à 23:27
Bonsoir à tous,
"Petites retouches" sur ton script, mistermail.
- parcours du folder "RepSearch";
a) si extension du fichier <> xml, rename du fichier dans le même folder avec extension .xml;
- envoi du mail:
si ok, move du fichier dans "RepStk" + write log;
si not ok, write log.
b) si extension du fichier = xml, envoi du mail;
- envoi du mail:
si ok, move du fichier dans "RepStk" + write log;
si not ok, write log.
Test mail non effectué
jean-marc
"Petites retouches" sur ton script, mistermail.
- parcours du folder "RepSearch";
a) si extension du fichier <> xml, rename du fichier dans le même folder avec extension .xml;
- envoi du mail:
si ok, move du fichier dans "RepStk" + write log;
si not ok, write log.
b) si extension du fichier = xml, envoi du mail;
- envoi du mail:
si ok, move du fichier dans "RepStk" + write log;
si not ok, write log.
Test mail non effectué
'***************************************************************
'Liste des paramètres pouvant être modifiés
Option Explicit
Const ForAppending = 8
Dim RepSearch, RepLog, RepStk, FichierTrace
'Répertoire de recherche
RepSearch="c:\recherche"
'Répertoire d'écriture du log
RepLog="c\log"
'Répertoire de stockage
RepStk="c:\stockage"
'Nom du fichier de trace
FichierTrace="Log.txt"
'***************************************************************
Dim objFso, objFile
Dim strFile, strLog, strNewFile
Dim FichierLog
FichierLog = RepLog & FichierTrace
Set objFso = CreateObject("Scripting.FileSystemObject")
For each objFile in objFso.GetFolder(RepSearch).Files
Select Case LCase(objFso.GetExtensionName(objFile))
Case "xml"
WriteLog Now & vbTab & "Le fichier """ & objFile.Path & """ existait déjà..." & _
"Tentative d'envoi du mail"
SendingMail(objFile.Path)
Case Else
strNewFile = RepSearch & Mid(objFile.Name, 1, InStrRev(objFile.Name, ".")) & "xml"
objFso.MoveFile objFile.Path, strNewFile
SendingMail(strNewFile)
End Select
Next
Set objFso = Nothing
'***************************************************************
Sub WriteLog(ArgLog)
Dim objLog
Set objLog = objFso.OpenTextFile(FichierLog, ForAppending, True)
objLog.Write ArgLog & vbcrlf
objLog.Close
Set objLog = Nothing
End Sub
'***************************************************************
Sub SendingMail(ArgFile)
Dim Emetteur, Destinataire, DestinataireCopie, SujetMail, CorpsMail, ServeurSMTP
'Paramétrage des attributs du mail (expéditeur, destinataires, copie, sujet, corps, serveur smtp)
Emetteur="<toto@toto.com>"
Destinataire="<tata@tata.com>
DestinataireCopie="<toto@toto.com>"
SujetMail="XML"
CorpsMail="Text
"
ServeurSMTP="smtp.toto.com"
Dim iMsg, iConf
'Create the message object.
Set iMsg = CreateObject("CDO.Message")
'Create the configuration object.
Set iConf = iMsg.Configuration
'Set the fields of the configuration object to send by using SMTP through port 25.
With iConf.Fields
.item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ServeurSMTP
.Update
End With
'Set the To, From, Subject, and Body properties of the message.
With iMsg
.To=Destinataire
.CC=DestinataireCopie
.From=Emetteur
.Subject=SujetMail
.HTMLBody=CorpsMail
.AddAttachment(ArgFile)
On Error Resume Next
.Send
If Err Then
WriteLog Now & vbTab & "Le fichier """ & objFile.Path & """ n'a pu être expédie."
On Error GoTo 0
Else
objFso.MoveFile ArgFile, RepStk
WriteLog Now & vbTab & "Le fichier """ & objFile.Path & _
""" a été envoyé avec Succès et a été copié à l'emplacement """ & _
RepStk & """." & vbCrLf
End If
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub
'***************************************************************
jean-marc
mistermail
Messages postés
2
Date d'inscription
jeudi 16 juillet 2009
Statut
Membre
Dernière intervention
4 août 2009
4 août 2009 à 09:37
4 août 2009 à 09:37
Merci c'est nikel. Ca fonctionne bien.
Dominique.
Dominique.
