ENVOIE DE MAIL

Signaler
Messages postés
65
Date d'inscription
jeudi 20 janvier 2005
Statut
Membre
Dernière intervention
25 juin 2010
-
Messages postés
39
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
21 mai 2015
-
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

Messages postés
39
Date d'inscription
vendredi 21 mars 2003
Statut
Membre
Dernière intervention
21 mai 2015

Bonjour à toutes et tous,

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
Messages postés
13
Date d'inscription
jeudi 13 octobre 2005
Statut
Membre
Dernière intervention
25 septembre 2007

Bonjour à tous,
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
Messages postés
1
Date d'inscription
vendredi 5 mai 2006
Statut
Membre
Dernière intervention
5 mai 2006

Bonjour à tous,

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.
Messages postés
7
Date d'inscription
lundi 16 mai 2005
Statut
Membre
Dernière intervention
21 mai 2005

Je travaille sur vb.net et il y a la variable "any" qui n est pas supporté dans vb.net que faire ? proteus91

Merci d avance
raysat
rheaberberi@hotmail.com
Afficher les 14 commentaires