Envoie de mail
4/5 (14 avis)
Vue 18 882 fois - Téléchargée 3 239 fois
Description
Bonjour, voilà je sais que plusieurs sources de ce type existe mais j'espère que la mienne vous permettra de mieu comprendre comment envoyer des mails, de plus je penses avoir plutot bien expliqué les fonctions et procedures public, donc voilà j'espere que ca vous aidera comme moi ca aurait pu m'aider quand je me prenais la tete a faire un programe qui pourrai gerer un fichier attaché.
Voila j'ai modifier le code aujourd'hui, je vous ai inclu les modifications que vous m'avez demandé afin de contourner le message de securité de windows, il vous suffit d'installer le fichier clicyes, et de laisser faire l'application. J'ai tenté de vous expliquer au mieu la communication entre l'appli et ClickYes. Voila j'espere que ca vous servira... Merci pour vos commentaires et vos notes.
Source / Exemple :
Seul petit hic... La securité de Outlook risque de s'ouvrir en vous disant de valider l'envoie du mail, si vous souhaitez faire un automate qui envoie plusieurs mails sans avoir à etre bloqué par cette procedure de Outlook envoyer moi un mail j'ai une parade.
Conclusion :
Voila j'ai modifier le code aujourd'hui, je vous ai inclu les modifications que vous m'avez demandé afin de contourner le message de securité de windows, il vous suffit d'installer le fichier clicyes, et de laisser faire l'application. J'ai tenté de vous expliquer au mieu la communication entre l'appli et ClickYes. Voila j'espere que ca vous servira... Merci pour vos commentaires et vos notes.
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
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.