ENVOIE DE MAIL
DakM
Messages postés
65
Date d'inscription
jeudi 20 janvier 2005
Statut
Membre
Dernière intervention
25 juin 2010
-
26 janv. 2005 à 16:45
cs_dchrist Messages postés 39 Date d'inscription vendredi 21 mars 2003 Statut Membre Dernière intervention 21 mai 2015 - 29 janv. 2007 à 10:07
cs_dchrist Messages postés 39 Date d'inscription vendredi 21 mars 2003 Statut Membre Dernière intervention 21 mai 2015 - 29 janv. 2007 à 10:07
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.
https://codes-sources.commentcamarche.net/source/29079-envoie-de-mail
https://codes-sources.commentcamarche.net/source/29079-envoie-de-mail
29 janv. 2007 à 10:07
Les codes de ce sujet sont super intéressants.
Cependant, j'ai toujours une fenêtre OutLook avec une barre de défilement même avec CLICKYES.
Y aurait-il des autorisations ou des paramètres bien particulier de OUTLOOK 2003 ?
A savoir, OUTLOOK est installé sur chaque poste utilisateur redirigé sur un serveur avec Exchange 2003.
Cordialement,
Dchrist
15 sept. 2006 à 09:10
C'est juste pour vous dire qu'on peux faire mieux, j'ai fait un petite applis qui dois traiter des mails et envoie ensuite un mail de confirmation comme quoi le traitement est Ok
Et le plus c'est que pas besoin de click Yes ca envoie le mail et outlook ne dis rien
Source:
'*****************************************************************************************************
'* Nom : Recup PJ DUE
'* Date de création : 14/06/2006
'* Auteur : Perney-loisel Frédéric
'* Description : Permet de récuperer les DUE's de outlook (Dossier Public DUE),d'enregistrer la piece jointe dans le bon repetoire et deplace le mail ds DUEOK
'*****************************************************************************************************
'Option Explicit
Dim objoutlook As Outlook.Application
Dim olns As Outlook.NameSpace
Dim mItem As Outlook.MailItem
Dim att As Outlook.Attachment
Dim fld As Outlook.MAPIFolder
Dim lcompteur, Lnbrpassage As Integer
Public Mfile As String
Private Sub Form_load()
lcompteur = 0
Lnbrpassage = 0
LTraitementPrincipal
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set fld = Nothing
Set olns = Nothing
Set objoutlook = Nothing
End Sub
Public Sub Pause(temps_a_attendre As Integer)
Dim endtime As Date
endtime = DateAdd("s", temps_a_attendre, Now)
Do Until Now > endtime
DoEvents
Loop
End Sub
Public Sub LTraitementPrincipal()
'On Error GoTo errorhandler
'Création de l'objet Outlook
Set objoutlook = CreateObject("Outlook.application")
'Récupération de l'espace de nom d'outlook
Set olns = objoutlook.GetNamespace("MAPI")
'Récupération du répertoire "dossier public" par défault
Set fld = olns.GetDefaultFolder(olPublicFoldersAllPublicFolders)
'Sauver les pieces jointes des mails se trouvant dans
'la boîte de réception. Pour adresser un dossier dans la boite
'de réception on pourrait utiliser :
'fld.Folders.Item("Nom_Du_Dossier").Items
'parcour des mails dans dossier public\test
For Each mItem In fld.Folders.Item("DUE").Items
'On incremente un compteur
lcompteur = lcompteur + 1
For Each att In mItem.Attachments 'pour chaque mail on recupere la piece jointe
If att.Type = olByValue Then
MonChemin = "\\SGECOMA9\d$\SPECIFIQUE\SERVICE_PAIE\_COMMUN\DUE\Cirso\AR" & att.FileName 'on le place dans un repertoire sur le disque
att.SaveAsFile MonChemin
'att.SaveAsFile "c:\temp" & att.FileName
'MsgBox "deleter le fichier"
Debug.Print "le fichier " & att.FileName & " a ete sauvegardé." 'commentaire d'execution
lstlog.AddItem att.FileName 'On affiche dans la liste box le nom du fichier sauvegarder
End If
Pause (20) ' appel de fonction qui met en pause notre probleme est que le repertoire cible imprime les piece jointe
' mais il faut lui laisser un temp d'action
TestFichierPresent 'Procedure qui test la presence du fichier si present on attend sinon on continue
Next
Next
Do 'boucle qui va permettre de deplacer les mails d'un repertoire a l'autre
For Each mItem In fld.Folders.Item("DUE").Items
mItem.Move fld.Folders.Item("DUE OK")
Next
lcompteur = lcompteur - 1
Loop While lcompteur > 0
lstlog.AddItem "-------------- Export terminer -------------- "
LEnvoieCdoMail
Exit Sub
errorhandler:
MsgBox Err.Description, , Err.Source
LEnvoieCdoMailErreur
End Sub
Public Sub TestFichierPresent()
Do
If Dir("\\SGECOMA9\d$\SPECIFIQUE\SERVICE_PAIE\_COMMUN\DUE\Cirso\AR\dpae.txt") <> "" Then
'If Dir("c:\temp") <> "" Then
fileexist = True
Lnbrpassage = Lnbrpassage + 1
'MsgBox fileexist 'fichier present
'on attend que le traitement se poursuive
If Lnbrpassage > 1 Then
'envoyer message d'erreur de traitement
MsgBox "erreur de traitement --- " & att.FileName, vbOKOnly
'LenvoieMail 'fonction d'envoie de mail
LEnvoieCdoMailErreur 'fonction d'envoie de mail 2eme méthode (CDO)
'Exit Do
End
Else
Pause (20)
End If
Else
Lnbrpassage = 0
fileexist = False
'MsgBox fileexist 'fichier absent
'si le fichier est absent alors le traitement c'est bien passer
Debug.Print "le fichier " & att.FileName & " est imprimer."
Mfile = att.FileName
End If
Loop While Dir("\\SGECOMA9\d$\SPECIFIQUE\SERVICE_PAIE\_COMMUN\DUE\Cirso\AR\dpae.txt") <> ""
'End
End Sub
Public Sub LEnvoieCdoMail()
Dim iMsg As New CDO.Message
Dim iConf As New CDO.Configuration
Dim Flds As ADODB.Fields
Set Flds = iConf.Fields
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "GEC-CTRL" ' Si vous utilisez la librairie CDO pour exchange
'.Item(cdoSMTPServerName) = "un serveur SMTP" ' Si vous utilisez la librairie CDO pour Windows 2000
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = "Login"
.Item(cdoSendPassword) = "Motdepasse"
.Item(cdoURLProxyServer) = "server:80"
.Item(cdoURLProxyBypass) = "<local>"
.Item(cdoURLGetLatestVersion) = True
.Update
End With
With iMsg
Set .Configuration = iConf
.To = """Admin GECOMA"" <MAil@Mail.com>"
.From = """Récup PJ DUE"" <MAil@Mail.Com>"
.Subject = "DUE OK"
.TextBody = "Traitement des DUE éffectués"
'.AddAttachment "C:\un fichier quelconque"
.Send
End With
Exit Sub
End Sub
Public Sub LEnvoieCdoMailErreur()
Dim iMsg As New CDO.Message
Dim iConf As New CDO.Configuration
Dim Flds As ADODB.Fields
Set Flds = iConf.Fields
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "NomServeur Smtp" ' Si vous utilisez la librairie CDO pour exchange
'.Item(cdoSMTPServerName) = "un serveur SMTP" ' Si vous utilisez la librairie CDO pour Windows 2000
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoBasic
.Item(cdoSendUserName) = "Login"
.Item(cdoSendPassword) = "Motdepasse"
.Item(cdoURLProxyServer) = "server:80"
.Item(cdoURLProxyBypass) = "<local>"
.Item(cdoURLGetLatestVersion) = True
.Update
End With
With iMsg
On Error Resume Next
Set .Configuration = iConf
.To = """Admin GECOMA"" <MAil@Mail.com>"
.From = """Récup PJ DUE"" <MAil@Mail.Com>"
.Subject = "Erreur DUE"
.TextBody = "Vérifier les DUE, Le fichier " & Mfile & " " & Err.Description & " " & Err.Source
'.AddAttachment "C:\un fichier quelconque"
.Send
End With
End
Exit Sub
End Sub
5 mai 2006 à 13:10
Je suis nouveau sur le site, et je fais de la programmation en VBA excel en amateur +.
Je viens de tester le CLickYes avec excel et cela fonctionne bien
je t'en remercie.
21 mai 2005 à 16:34
Merci d avance
raysat
rheaberberi@hotmail.com
21 mai 2005 à 16:32
Merci d avance
raysat
rheaberberi@hotmail.com
21 mai 2005 à 16:31
Merci d avance
raysat
rheaberberi@hotmail.com
7 mars 2005 à 23:04
7 mars 2005 à 22:59
12 févr. 2005 à 19:57
27 janv. 2005 à 16:02
par contre, toujours pas de solution intégré pour Outlook...
bonne source et bonnes infos.
merci.
27 janv. 2005 à 15:04
27 janv. 2005 à 12:55
26 janv. 2005 à 17:24
26 janv. 2005 à 16:45
A la ligne ou ya ecrit ".SEND"