Classe d'objet de générateur de mail outlook avec mise en forme via une syntaxe html

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 101 fois - Téléchargée 20 fois

Commenter

Contenu du snippet

Ayant il y a quelques mois développé le "GÉNÉRATEUR DE MAIL LOTUS NOTES AVEC MISE EN FORME VIA UNE SYNTAXE HTML" (voir dans mes sources précédentes sur ce site), je me suis dit :
"Et pourquoi pas en faire l'équivalent avec Outlook ?"

Ceci est désormais fait et vous trouverez ci-dessous les fonctionnalités :

- Peut s'exécuter sans qu'Outlook soit lancé au préalable
- Choix du profil Outlook avec ou sans mot de passe
- Permet ou non de rendre visible l'interface
  • Uniquement pour Office 2007 et plus *
  • - Choix de l'expéditeur par son adresse ou son alias *

- Insertion et suppression de un ou plusieurs destinataires
- Insertion et suppression de un ou plusieurs destinataires en copie
- Insertion et suppression de un ou plusieurs destinataires en copie invisible
- Insertion et suppression de une ou plusieurs pièces jointes
- Incrustation d'une ou plusieurs images dans le corps du message
- Renvoie du code HTML de l'image incrustée en fonction du nom de l'image
- Suppression d'une image incrustée dans le message
- Possibilité d'envoyer le message générer ou de l'afficher avant un envoi manuel
- Possibilité de ranger le message dans le dossier de son choix
  • Nota Bene ! *
  • Sur mon lieu de travail, j'ai des dossiers dont l'accès m'est refusé. *
  • Comme le numéro d'erreur dépend de chaque dossier refusé, j'ai du prendre*
  • Err.Description pour gérer cette erreur. *
  • Vérifiez que cette description est conforme sur votre poste pour pouvoir *
  • ranger un message envoyé (procédure Genere_message) *

Source / Exemple : 


Option Explicit
'Auteur Florent Bénetière : tnerolf@lekod.com
'Cette classe d'objet a pour but de gérer la création, l'envoi et le rangement de messages au format HTML

'Bibliothèques nécessaires
'Library Office
'    [Chemin vers Program Files]\Fichiers communs\Microsoft Shared\[Version du Pack Office]\MSO.DLL
'    Microsoft Office [Version du Pack Office] Object Library

'API
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Ootlook As New Outlook.Application

Private Racine As Namespace  'Haut de la hiérarchie d'Outlook

Private Profil As String

Private Mdp As String

Private ID As String 'Pour éventuellement retrouver le message et le déplacer vers un dossier Outlook une fois celui-ci envoyé

'Le mail
Private Courriel As Outlook.MailItem

Public From As String
'From peut être renseigné soit par l'alias d'un compte, soit par son adresse si l'on ne veut pas le compte d'envoi par défaut.

'Les destinataires
Private Tbl_To() As String
Private Tbl_Cc() As String
Private Tbl_Cci() As String

'Les pièces jointes
Private Tbl_PJ() As String

Private Tbl_Img_incrust() As String
'Tbl_Img_incrust est de structure [Chemin vers le fichier][Code HTML d'insertion de l'image][x]

'Le sujet
Public Sujet As String

'Le corps HTML du message
Public HTML As String

Public Sub Associe_profil(Nom As String)
    Profil = Nom
    If Len(Profil) > 0 And Len(Mdp) > 0 Then Lance_Outlook
End Sub

Public Sub Associe_Mot_de_passe(Valeur As String)
    Mdp = Valeur
    If Len(Profil) > 0 And Len(Mdp) > 0 Then Lance_Outlook
End Sub

Property Let Importance(Urgence As String)
Dim Priorite As Byte
'Urgence peut être
'Basse, Normale, Haute
If Urgence = "Basse" Then
    Priorite = olImportanceLow
ElseIf Urgence = "Haute" Then
    Priorite = olImportanceHigh
Else
    Priorite = olImportanceNormal
End If
Courriel.Importance = Priorite
End Property

Private Sub Class_Initialize()
'On initialise les tableaux
'Les messages
ReDim Tbl_Courriel(0)

'Les destinataires
ReDim Tbl_To(0)
ReDim Tbl_Cc(0)
ReDim Tbl_Cci(0)

'Les pièces jointes
ReDim Tbl_PJ(0)

'Les images incrustées
ReDim Tbl_Img_incrust(1, 0)

'Le message
Set Courriel = Ootlook.CreateItem(olMailItem)
'L'ID du message
ID = Creer_nom_aleatoire()
End Sub

Private Sub Supprimer_ligne_Tbl(Quel_tableau As String, Valeur As String)
'Cette procédure supprime la ligne du tableau Quel_tableau contenant la valeur Valeur
'Passer "Tout" comme Valeur pour vider entièrement le tableau Quel_tableau
Dim Tableau As Variant, a As Integer, Taille As Integer
Dim Pointeur As String, PJ As Attachment
Dim Regle As New RegExp

Select Case Quel_tableau
    Case "To"
        Tableau = Tbl_To
    Case "Cc"
        Tableau = Tbl_Cc
    Case "Cci"
        Tableau = Tbl_Cci
    Case "PJ"
        Tableau = Tbl_PJ
    Case "Image"
        Tableau = Tbl_Img_incrust
End Select

If Quel_tableau = "Image" Then
    Taille = UBound(Tableau, 2)
Else
    Taille = UBound(Tableau)
End If

With Courriel
    For a = 0 To Taille
        If Quel_tableau = "Image" Then
            Pointeur = Tableau(0, a)
        Else
            Pointeur = Tableau(a)
        End If
        
        If (Pointeur Like "*" & Valeur & "*" Or Valeur = "Tout") And _
        Len(Pointeur) > 0 Then
        Select Case Quel_tableau
            Case "To", "Cc", "Cci"
                'On est obligé de faire appel à une expression r&égulière
                'car la dernière adresse de la liste n'a plus son ";"
                With Regle
                    .Global = True
                    .IgnoreCase = True
                    .Pattern = Pointeur & ";?"
                    
                    If Quel_tableau = "To" Then
                        Courriel.To = .Replace(Courriel.To, vbNullString)
                    ElseIf Quel_tableau = "Cc" Then
                        Courriel.Cc = .Replace(Courriel.Cc, vbNullString)
                    Else
                        Courriel.BCC = .Replace(Courriel.BCC, vbNullString)
                    End If
                    Tableau(a) = vbNullString
                    If Valeur <> "Tout" Then Exit For
                End With
            Case "PJ", "Image"
                If Quel_tableau = "Image" Then
                'S'il s'agit d'une incrustation on supprime le code HTML pointant vers l'image incrustée
                    With Regle
                        .IgnoreCase = True
                        .Global = True
                        .Pattern = "<img[^>]+src=""" & Valeur & """[^>]+>"
                        
                        HTML = .Replace(HTML, vbNullString)
                        Courriel.HTMLBody = HTML
                    End With
                End If
                
                For Each PJ In .Attachments
                    If Pointeur Like "*" & PJ.Filename & "*" Then
                        .Attachments.Remove PJ.Index
                        Exit For
                    End If
                Next PJ
                
                If Quel_tableau = "Image" Then
                    Tableau(0, a) = vbNullString: Tableau(1, a) = vbNullString
                Else
                    Tableau(a) = vbNullString
                End If
                If Valeur <> "Tout" Then Exit For
        End Select
        End If
    Next a
End With

'On met à jour le tableau cible
Select Case Quel_tableau
    Case "To"
        Tbl_To = Tableau
    Case "Cc"
        Tbl_Cc = Tableau
    Case "Cci"
        Tbl_Cci = Tableau
    Case "PJ"
        Tbl_PJ = Tableau
    Case "Image"
        Tbl_Img_incrust = Tableau
End Select
End Sub

Public Sub Suppr_To(Adresse As Variant)
'Passer "Tout" pour supprimer tous les To
Dim Ligne As Variant

If IsArray(Adresse) Then
    For Each Ligne In Adresse
        Supprimer_ligne_Tbl "To", CStr(Ligne)
    Next Ligne
Else
    Supprimer_ligne_Tbl "To", CStr(Adresse)
End If
End Sub

Public Sub Suppr_Cc(Adresse As Variant)
'Passer "Tout" pour supprimer tous les Cc
Dim Ligne As Variant

If IsArray(Adresse) Then
    For Each Ligne In Adresse
        Supprimer_ligne_Tbl "Cc", CStr(Ligne)
    Next Ligne
Else
    Supprimer_ligne_Tbl "Cc", CStr(Adresse)
End If
End Sub

Public Sub Suppr_Cci(Adresse As Variant)
'Passer "Tout" pour supprimer tous les Cci
Dim Ligne As Variant

If IsArray(Adresse) Then
    For Each Ligne In Adresse
        Supprimer_ligne_Tbl "Cci", CStr(Ligne)
    Next Ligne
Else
    Supprimer_ligne_Tbl "Cci", CStr(Adresse)
End If
End Sub

Public Sub Suppr_PJ(Nom_fichier As Variant)
'Mettre uniquement le nom du fichier, pas le chemin complet
'Passer "Tout" pour supprimer toutes les pièces jointes
Dim Ligne As Variant

If IsArray(Nom_fichier) Then
    For Each Ligne In Nom_fichier
        Supprimer_ligne_Tbl "PJ", CStr(Ligne)
    Next Ligne
Else
    Supprimer_ligne_Tbl "PJ", CStr(Nom_fichier)
End If
End Sub

Public Sub Suppr_Incrustation(Image As Variant)
'Mettre uniquement le nom du fichier, pas le chemin complet
'Passer "Tout" pour supprimer toutes les images incrustées
Dim Ligne As Variant

If IsArray(Image) Then
    For Each Ligne In Image
        Supprimer_ligne_Tbl "Image", CStr(Ligne)
    Next Ligne
Else
    Supprimer_ligne_Tbl "Image", CStr(Image)
End If
End Sub

Public Sub Ajoute_To(Destinataires As Variant)
Dim Ligne As Variant
If IsArray(Destinataires) Then
    For Each Ligne In Destinataires
        Tbl_To(UBound(Tbl_To)) = Ligne
        ReDim Preserve Tbl_To(UBound(Tbl_To) + 1)
    Next Ligne
Else
    Tbl_To(UBound(Tbl_To)) = Destinataires
    ReDim Preserve Tbl_To(UBound(Tbl_To) + 1)
End If
End Sub

Public Sub Ajoute_Cc(Destinataires As Variant)
Dim Ligne As Variant
If IsArray(Destinataires) Then
    For Each Ligne In Destinataires
        Tbl_Cc(UBound(Tbl_Cc)) = Ligne
        ReDim Preserve Tbl_Cc(UBound(Tbl_Cc) + 1)
    Next Ligne
Else
    Tbl_Cc(UBound(Tbl_Cc)) = Destinataires
    ReDim Preserve Tbl_Cc(UBound(Tbl_Cc) + 1)
End If
End Sub

Public Sub Ajoute_Cci(Destinataires As Variant)
Dim Ligne As Variant
If IsArray(Destinataires) Then
    For Each Ligne In Destinataires
        Tbl_Cci(UBound(Tbl_Cci)) = Ligne
        ReDim Preserve Tbl_Cci(UBound(Tbl_Cci) + 1)
    Next Ligne
Else
    Tbl_Cci(UBound(Tbl_Cci)) = Destinataires
    ReDim Preserve Tbl_Cci(UBound(Tbl_Cci) + 1)
End If
End Sub

Public Sub Ajoute_PJ(Pieces As Variant)
'On ajoute une pièce jointe si et seulement si elle ne l'a pas été au préalable
Dim Ligne0 As Variant, Ligne1 As Variant, Drapeau_existe As Boolean
If IsArray(Pieces) Then
    For Each Ligne0 In Pieces
        For Each Ligne1 In Tbl_PJ
            If Ligne0 = Ligne1 Then
                Drapeau_existe = True
                Exit For
            End If
        Next Ligne1
        
        If Not Drapeau_existe Then
            Tbl_PJ(UBound(Tbl_PJ)) = Ligne0
            ReDim Preserve Tbl_PJ(UBound(Tbl_PJ) + 1)
            Courriel.Attachments.Add Ligne0
        End If
        
        Drapeau_existe = False
    Next Ligne0
Else
    For Each Ligne0 In Tbl_PJ
        If Ligne0 = Pieces Then
            Drapeau_existe = True
            Exit For
        End If
    Next Ligne0
    
    If Not Drapeau_existe Then
        Tbl_PJ(UBound(Tbl_PJ)) = Pieces
        ReDim Preserve Tbl_PJ(UBound(Tbl_PJ) + 1)
        Courriel.Attachments.Add Pieces
    End If
End If
End Sub

Public Sub Ajoute_Image(Chemin_Images As String, Optional Infobulle As String = vbNullString, _
Optional Alignement As String = "baseline", Optional Epaisseur_Bordure As Byte = 0, _
Optional PJ_Image_visible As Boolean = True, Optional Hauteur As String, Optional Largeur As String)

'On ajoute une image si et seulement si elle ne l'a pas été au préalable
'On renseigne Tbl_Img_incrust en conséquence

'***************************************************************************************************
'*            POUR QUE L'IMAGE SOIT BIEN VISIBLE SUR DES MESSAGERIES AUTRE QU'OUTLOOK              *
'* Il faut absolument, en aval, si cette fonction est appelée pour joindre le fichier image        *
'* et après la récupération du code de l'image ajouter les lignes suivante pour qu'Outlook compile *
'* correctement le message                                                                         *
'*                                                                                                 *
'*    Message.Display                                                                              *
'*    Message.BodyFormat = olFormatHTML                                                            *
'*    Message.HTMLBody = HTML                                                               *
'***************************************************************************************************

Dim a As Byte, Taille As Byte, Drapeau_existe As Boolean, Nom_image As String
Dim Nombre_attachements As Byte

Taille = UBound(Tbl_Img_incrust, 2)

For a = 0 To Taille
    If Chemin_Images = Tbl_Img_incrust(0, a) Then
        Drapeau_existe = True
        Exit For
    End If
Next a

If Not Drapeau_existe Then
    Nom_image = Mid(Chemin_Images, InStrRev(Chemin_Images, "\") + 1)
    Nombre_attachements = Courriel.Attachments.Count
    Courriel.Attachments.Add Chemin_Images, olByValue, IIf(PJ_Image_visible, 88888888, 0), Nom_image
'    'IIf(PJ_Image_visible, 88888888, 0)
'    'Si PJ_Image_visible est vrai, on met la position du fichier joint dans le message à la fin de ce dernier
'    'Cela explique la position 88888888
'    'Si ce nombre est élevé, c'est pour être certain que le fichier soit joint après le contenu HTML du message.
'    'En effet, si ce n'est pas le cas, certaines messageries, comme, par exemple, les Black Berry, ne voient pas l'image s'afficher du premier coup.
'    'De plus, le fait de mettre le contenu des pièces jointes en fin de message est conforme aux normes d'élaboration
'    'de ces derniers qui veut que la partie encodée en hexadécimale des pièces jointes se trouvent après le corps du message.
'
'    'Si PJ_Image_visible=Faux, La pièce jointe ne sera pas affichée dans le champ "Pièce jointe" du message.
'
    'Tant que l'image n'est pas jointe au message, on boucle
    While Nombre_attachements = Courriel.Attachments.Count
        DoEvents
    Wend

    Tbl_Img_incrust(0, Taille) = Chemin_Images
    Tbl_Img_incrust(1, Taille) = "<img alt=""" & Infobulle & """ hspace=0 src=""" & Nom_image & """ align=""" & _
    Alignement & """ border=""" & Epaisseur_Bordure & """" & _
    IIf(Len(Hauteur) > 0, """ height=""" & Hauteur & """", vbNullString) & _
    IIf(Len(Hauteur) > 0, """ width= """ & Largeur & """", vbNullString) & ">"
    
    ReDim Preserve Tbl_Img_incrust(1, UBound(Tbl_Img_incrust, 2) + 1)
End If
End Sub

Public Sub Modifie_Image_Incrustee(Image As String, Optional Infobulle As String = vbNullString, _
Optional Alignement As String = "baseline", Optional Epaisseur_Bordure As Byte = 0, _
 Optional Hauteur As String, Optional Largeur As String)
'Cette procédure modifie le code HTML associé à une image incrustée
'Image peut être soit le nom du fichier, soit le chemin complet menant vers l'image
Dim a As Byte, Taille As Byte

Taille = UBound(Tbl_Img_incrust, 2)

For a = 0 To Taille
    If InStr(1, Tbl_Img_incrust(0, a), Image) > 0 Then
        Tbl_Img_incrust(1, a) = _
        "<img alt=""" & Infobulle & """ hspace=0 src=""" & Image & """ align=""" & _
    Alignement & """ border=""" & Epaisseur_Bordure & """" & _
    IIf(Len(Hauteur) > 0, """ height=""" & Hauteur & """", vbNullString) & _
    IIf(Len(Hauteur) > 0, """ width= """ & Largeur & """", vbNullString) & ">"
        Exit Sub
    End If
Next a
End Sub

Public Function Renvoie_HTML_image_incrustee(Image As String) As String
'Cette fonction renvoie le code HTML d'insertion de l'image Image
'Image peut être soit le nom du fichier, soit le chemin complet menant vers l'image
Dim a As Byte, Taille As Byte

Taille = UBound(Tbl_Img_incrust, 2)

For a = 0 To Taille
    If InStr(1, UCase(Tbl_Img_incrust(0, a)), UCase(Image)) > 0 Then
        Renvoie_HTML_image_incrustee = Tbl_Img_incrust(1, a)
        Exit Function
    End If
Next a

End Function

Public Sub Lance_Outlook()
'Cette procédure permet d'ouvrir Outlook s'il ne l'est pas et initialise Racine
'Si Outlook n'est pas ouvert, on le fait

Dim Nlle_Session As Boolean

Nlle_Session = IIf(NbreProcess("Outlook.exe") = 0, True, False)

Set Racine = Ootlook.GetNamespace("Mapi")

'On ouvre une session
Racine.Logon Profil, Mdp, False, Nlle_Session
End Sub

Private Function NbreProcess(ByVal ProcessName As String) As Byte
Dim svc As Object
Dim sQuery As String
Dim oproc As Variant
Dim Compteur As Byte

On Error Resume Next

Set svc = GetObject("winmgmts:root\cimv2")
sQuery = "select * from win32_process where name='" & ProcessName & "'"

For Each oproc In svc.execquery(sQuery)
    Compteur = Compteur + 1
Next

Set svc = Nothing
NbreProcess = Compteur
On Error GoTo 0
End Function

Public Sub Nouveau_message()
'Cette procédure crée un nouveau message et l'associe à Courriel
'***************************************************************************************************
'* !!        SI VOUS CREEZ UN NOUVEAU MESSAGE, IL N'Y AURA PLUS DE HANDLE VERS LE PRECEDENT !!     *
'***************************************************************************************************
Set Courriel = Ootlook.CreateItem(olMailItem)
ID = Creer_nom_aleatoire()
End Sub

Public Sub Genere_message(Optional Envoi As Boolean = False, Optional Rangement As String, Optional Visible As Boolean = True)
'Cette procédure crée le message
'si Envoi est Vrai, le message est envoyé, sinon il est sauvegardé et affiché
'Rangement s'il est renseigné, déplace le message dans le dossier indiqué SI ET SEULEMENT SI ce dernier a été envoyé

'Si Visible est Vrai, alors on voit l'interface d'Outlook

Dim Explo As Outlook.Explorer, Ligne As Variant
Dim Dossier As Outlook.Folder, Dossier_rangement As Outlook.Folder, Message As MailItem
Dim Champ_adresse As String, Drapeau_archive As Boolean
'Uniquement valable à partir d'Outlook 2007
Dim Compte As Account

On Error GoTo Erreurs

If TypeName(Racine) = "Nothing" Then Lance_Outlook

If Visible Then
    If Ootlook.Explorers.Count > 0 Then
        Set Explo = Ootlook.Explorers(1)
    Else
        Set Explo = Ootlook.Explorers.Add(Racine.Folders(1), olFolderDisplayNormal)
    End If

    Explo.Activate
End If

With Courriel
'***********************************************
'*  Valable uniquement à partir d'Outlook 2007 *
'***********************************************
    If Len(From) > 0 Then
        For Each Compte In Racine.Accounts
            If UCase(Compte.UserName) = UCase(From) Or UCase(Compte.SmtpAddress) = UCase(From) Then
                .SendUsingAccount = Compte
                Exit For
            End If
        Next Compte
    End If
'***********************************************
    .Subject = Sujet
    .BodyFormat = olFormatHTML
    .HTMLBody = HTML 'On laisse le soin à Word 2007 d'interpréter le code HTML à la sauce Office 2007
    'Comme les commentaires HTML sont supprimés par Outlook lorsqu'il compile le message lors de l'envoi,
    'On ajoute un paragraphe contenant l'ID du message à la fin de ce dernier.
    'style="display:none" permet de le rendre invisible
    .HTMLBody = .HTMLBody & "<p style=""display:none"">" & ID & "</p>" 'On insère l'ID du message afin de le retouver dans les éléments envoyés
    'si on veut le ranger dans un dossier.
    'En effet, l'IdEntry du message change lorsqu'il est envoyé

    For Each Ligne In Tbl_To
        If Len(Ligne) > 0 Then Champ_adresse = Champ_adresse & Ligne & ";"
    Next Ligne
    .To = Champ_adresse
    Champ_adresse = vbNullString
    
    For Each Ligne In Tbl_Cc
        If Len(Ligne) > 0 Then Champ_adresse = Champ_adresse & Ligne & ";"
    Next Ligne
    .Cc = Champ_adresse
    Champ_adresse = vbNullString
    
    For Each Ligne In Tbl_Cci
        If Len(Ligne) > 0 Then Champ_adresse = Champ_adresse & Ligne & ";"
    Next Ligne
    .BCC = Champ_adresse
    
    .Save
    If Envoi Then
        'On récupère l'ID de ce dernier car elle va nous servir à le retrouver
        'ID_Message = .EntryID
        'On ne peut pas utiliser EntryID car cette valeur change lorsque le message est déplacé
        'dans un autre répertoire
        .Send
        Sleep 200 'On laisse le temps à Outlook de copier le message dans le dossier Envoyé
        If Len(Rangement) > 0 Then
            'On détermine le dossier de rangement
            For Each Dossier In Racine.Folders
                Set Dossier_rangement = Recherche_dossier(Dossier, Rangement, True)
                Sleep 300 'On laisse le temps à Outlook d'associer le dossier à la variable
                If Dossier_rangement.Name = Rangement Then
                    'Lorsqu'un message est envoyé il est ou non copié dans le dossier "Éléments envoyés"
                    'Si c'est le cas, on le déplace dans Rangement
                    Set Dossier = Racine.GetDefaultFolder(olFolderSentMail)

                    For Each Message In Dossier.Items
                        If InStr(1, Message.HTMLBody, ID) > 0 Then
                            Drapeau_archive = True 'Pour savoir s'il faut ou non déplacer le message
                            Message.Move Dossier_rangement 'car il est possible de demander à Outlook
                            'de ne pas enregistrer une copie des messages envoyés dans "Eléments envoyés"
                            Exit For
                        End If
                    Next Message

                    'Tant que le message n'a pas été déplacé, on boucle
                    While Drapeau_archive
                        For Each Message In Dossier_rangement.Items
                            If InStr(1, Message.HTMLBody, ID) > 0 Then
                                Drapeau_archive = False
                                Exit For
                            End If
                        Next Message
                        DoEvents
                    Wend
                    
                    Exit For
                End If
Suite:     Next Dossier
        End If
        Exit Sub
    Else
        .Display
    End If
End With
Exit Sub
Erreurs:
If Err.Description = "Impossible d'ouvrir l'élément. Recommencez." Then 'Impossible d'ouvrir le dossier
    Resume Suite 'On passe au dossier suivant
Else
    EnvoiErreur "Genere_message", Err.Number, Err.Description
End If
End Sub

Private Function Recherche_dossier(Dossier_racine As Outlook.Folder, Nom As String, Optional Reinit As Boolean = False) As Outlook.Folder
'Cette fonction récursive recherche un dossier ayant le nom Nom et le renvoie
'La recherche est insensible à la casse
Dim Dossier As Outlook.Folder, Ss_Dossier As Outlook.Folder
Static Trouve As Boolean

If Reinit Then Trouve = False

If Trouve Then Exit Function

Set Dossier = Dossier_racine
Set Recherche_dossier = Dossier

If UCase(Dossier) = UCase(Nom) Then
    Trouve = True
    Exit Function
End If

With Dossier
    If .Folders.Count > 0 Then
        For Each Ss_Dossier In .Folders
            Set Recherche_dossier = Recherche_dossier(Ss_Dossier, Nom)
            If Trouve Then Exit Function
        Next Ss_Dossier
    End If
End With
End Function

Public Sub Affiche_Courriel()
Courriel.Display
End Sub

Public Sub Reinit_Message()
'Cette procédure vide tous les conteneurs associés à un message
Suppr_To "Tout"
Suppr_Cc "Tout"
Suppr_Cci "Tout"
Suppr_PJ "Tout"
Suppr_Incrustation "Tout"
End Sub

Private Function Creer_nom_aleatoire(Optional Prefixe As String = "Message_") As String
' Cette fonction renvoie un nom aléatoire
    Randomize
    Creer_nom_aleatoire = Replace(Prefixe & Format(Now(), "YYYYmmddhhnn") & CStr(CLng(100000000 * Rnd())), "E-", "")
End Function

Conclusion :


Exemple du code de Recette de la classe d'objet

Sub Recette()
Dim Ootlook As New Cls_Outlook
With Ootlook
.Associe_profil "PROFIL PAR DEFAUT"
.Lance_Outlook
.Ajoute_To "Adresse1@chezmoi.fr"
.Ajoute_To Array("Adresse2@chezmoi.fr", "Adresse3@chezmoi.fr")
.Ajoute_Cc "Adresse4@chezmoi.fr"
.Ajoute_Cc Array("Adresse5@chezmoi.fr", "Adresse6@chezmoi.fr")
.Ajoute_Cci "Adresse7@chezmoi.fr"
.Ajoute_Cci Array("Adresse8@chezmoi.fr", "Adresse9@chezmoi.fr")
.Ajoute_PJ "D:\Temp\Encrypt PHP\pelog.txt"
'Test pour ne pas insérer de doublons
.Ajoute_PJ "D:\Temp\Encrypt PHP\pelog.txt"
.Ajoute_PJ Array("D:\Temp\FirefoxPortable\Other\Help\images\help_background_footer.png", "D:\Temp\FirefoxPortable\Other\Help\images\help_background_header.png")
.Ajoute_PJ Array("D:\Temp\FirefoxPortable\Other\Help\images\help_background_footer.png", "D:\Temp\FirefoxPortable\Other\Help\images\help_background_header.png")
.Ajoute_Image "D:\Temp\FirefoxPortable\Other\Help\images\donation_button.png"
'Test pour ne pas insérer de doublons
.Ajoute_Image "D:\Temp\FirefoxPortable\Other\Help\images\donation_button.png"
.Modifie_Image_Incrustee "donation_button.png", "Un test de modif du src de l'image", , 4
.Ajoute_Image "D:\Temp\FirefoxPortable\Other\Source\FirefoxPortable.jpg"
.Sujet = "Recette"
.HTML = .Renvoie_HTML_image_incrustee("donation_button.png") & "<br><br>" & _
.Renvoie_HTML_image_incrustee("FirefoxPortable.jpg") & "<br><br>" & _
.Renvoie_HTML_image_incrustee("donation_button.png")
.Affiche_Courriel
.Genere_message
'Recette des suppressions
.Suppr_To "Adresse2@chezmoi.fr"
.Suppr_To Array("Adresse2@chezmoi.fr", "Adresse1@chezmoi.fr")
.Suppr_Cc "Tout"
.Suppr_Cci "Adresse9@chezmoi.fr"
.Suppr_PJ "help_background_footer.png"
.Suppr_PJ Array("J'existe pas", "et moi non plus")
.Suppr_Incrustation "donation_button.png"
.Suppr_To "Tout"
.Suppr_Cci "Tout"
.Suppr_PJ "Tout"
.From="Florent Bénetière"
.Ajoute_To "Ma_vraie_adresse_a_moi@mon_domaine.com"
.Importance = "Basse"
.Genere_message True, "Mon dossier de rangement"
End With
End Sub

A voir également

Ajouter un commentaire Commentaire
mimi35garry Messages postés 21 Date d'inscription mercredi 21 janvier 2009 Statut Membre Dernière intervention 8 février 2013
3 déc. 2011 à 21:58
.
S'inscrire maintenant

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.

Du même auteur (cs_8Tnerolf8)