Emailing Excel 2003/Outlook 2003.. (Contribution)

[Ipéfix]

Bonjour,
Pour avoir personnellement un peu galéré sur le sujet , j'ai glané çà et là des informations.
Juste retour des choses après avoir sollicité votre aide sur d'autres sujets, je vous propose une solution complète...
Celle-ci permet d'automatiser l'envoi d'Email:
- avec choix interactif de pièce(s) jointe(s)
- Sélection de destinataire(s) définis préalablement dans une feuille de calcul (complétion des champs TO et CC de l'email)
- Récupération du sujet et du corps de message (Complétion des champs SUBJECT et BODY de l'email)

Les axes d'amélioration :Saisie interactive du sujet et du corps de message.

Espérant que cette modeste contribution soit utile...
Bien cordialement,
Ipéfix

Sub EnvoiMail_PieceJointe()
'Necessite la référence à Microsoft Outlook xx Object Library (Outils_Réferences)
    Dim Fichiers As Variant
    Dim i As Integer
    Dim Ol As Outlook.Application
    Dim olMail As MailItem
    Dim Pri_Dest As String
    Dim Sec_Dest As String
    
'Récupération de la liste des destinataires (feuille DESINATAIRES du classeur)
    Pri_Dest = Worksheets("Destinataires").Range("B20").Value
    Sec_Dest = Worksheets("Destinataires").Range("C20").Value
    
'Sélection du ou des fichiers à joindre"
    Fichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", , , , True)
       
   Set Ol = New Outlook.Application
   Set olMail = Ol.CreateItem(olMailItem)
   
 ' Mise en forme de l'Email
    With olMail
    'Destinataire
        .To = Pri_Dest
    'Complétion de l'Email
        .CC = Sec_Dest
        .Subject = "TEST EMAILING "
        .Body = "Bonjour," & vbCrLf & "Voici le fichier attendu, actualisé au " & Date - 1 & vbCrLf & _
        vbCrLf & "Cordialement." & vbCrLf & "Ipéfix"
           
  'Permet la sélection multiples de fichiers puis intègre les pièces jointes dans l'Email
  '(La sélection multiple de fichiers se fait par la touche CTRL + clic gauche)
        If IsArray(Fichiers) Then
            For i = 1 To UBound(Fichiers)
                .Attachments.Add Fichiers(i)
            Next
        End If
 'Au choix, Affichage ou Envoi de l'Email
   'Affiche l'Email
        .Display
   'Envoi de l'Email
        '.Send
End With
End Sub
 

Une variante, avec les destinataires "en dur" dans le code :

Sub EnvoiMail_PieceJointe()
'Necessite la référence à Microsoft Outlook xx Object Library (Outils_Réferences)
    Dim Fichiers As Variant
    Dim i As Integer
    Dim Ol As Outlook.Application
    Dim olMail As MailItem
    Dim Pri_Dest As String
    Dim Sec_Dest As String
        
'Sélection du ou des fichiers à joindre"
    Fichiers = Application.GetOpenFilename("Tous les fichiers (*.*),*.*", , , , True)
       
   Set Ol = New Outlook.Application
   Set olMail = Ol.CreateItem(olMailItem)
   
 ' Mise en forme de l'Email
    With olMail
    'Destinataire(s)
        .To = "Toto@bibi.org;Bebert@nowhere.com"
    'Complétion de l'Email
        .CC = "Loulou@bob.com;Tonton@salut.net"
        .Subject = "Mise à jour du fichier hebdomadaire "
        .Body = "Bonjour," & vbCrLf & "Voici le fichier attendu, actualisé au " & Date - 1 & vbCrLf & _
        vbCrLf & "Cordialement." & vbCrLf & "Ipéfix"
           
  'Permet la sélection multiples de fichiers puis intègre les pièces jointes dans l'Email
  '(La sélection multiple de fichiers se fait par la touche CTRL + clic gauche)
        If IsArray(Fichiers) Then
            For i = 1 To UBound(Fichiers)
                .Attachments.Add Fichiers(i)
            Next
        End If
 'Au choix, Affichage ou Envoi de l'Email
   'Affiche l'Email
        .Display
   'Envoi de l'Email
        '.Send
End With
End Sub

[babybell]

Merci beaucoup

Bonne soirée