envoyer une feuille xls par mail

creolia

XLDnaute Impliqué
Bonjour à tous

j'ai récupéré cette macro sur le forum

Code:
Option Explicit

' --------- Envoi d'un mail avec Lotus Notes ---------- .
'Ajouter la référence Lotus Domino Objects (domobj.tlb) .
'Cocher Référence  [x]Lotus Domino Objects              .
'entrée du CheminEtFichier s'il y a lieu
'entrée Sujet et Message As String

Sub EnvoiMailLocal() '(CheminEtFichier As String, Sujet As String, Message As String)
    Dim oSession As Object     'CreateObject("Notes.NotesSession")
    Dim UserName As String     'Nom d'utilisateur
    Dim DataBase As Object     'Base des mails
    Dim DataBaseName As String 'Nom de la base
    Dim Document As Object     'Mail
    Dim AttachME As Object     'Fich joint en RTF
    Dim AttachF1 As Object     '1' pièce attachée
    Dim i, j, txtbody, CheminEtFichier, Msg$, T$
    
    On Error GoTo ErreurNET: Err.Clear '*****
    
    ' Crée la session
    Set oSession = CreateObject("Notes.NotesSession")
    ' Récupère nom d'utilisateur
    UserName = oSession.UserName
    DataBaseName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    ' Ouvre la base des mails (si fermé, ouvre et demande le password)
    Set DataBase = oSession.GetDataBase("", DataBaseName)
    If Not DataBase.IsOpen Then DataBase.OpenMail
    
    '########################## envoi ###############################################
    'récupère dans la feuille nommée NomDeLaFeuilDATA$ et le Range nommé "CellDATA_AdresDestinataire"
    'les adresses séparées par ";"
    Dim Tablo As Variant, AdresDestinataire As String
    AdresDestinataire = Sheets("data").Range("b5")
    If InStr(AdresDestinataire, ";") = 0 Then AdresDestinataire = AdresDestinataire & ";"
    Tablo = Split(AdresDestinataire, ";")
    '       boucle envoi                 .
    For i = LBound(Tablo) To UBound(Tablo)
     If Trim(Tablo(i)) > "" Then
        AdresDestinataire = Tablo(i)
        
        'crée le document et colle /AdresDestinataire /Sujet /Message
        Set Document = DataBase.CreateDocument
        Document.Form = "Memo"
        Document.Sendto = AdresDestinataire
        Document.Subject = "Test Envoi Mail depuis Excel"
        
        'définition du corps du message
        For j = 1 To 10
            txtbody = Sheets("data").Range("b5")
        Next j
        Document.Body = txtbody
        
        'Joint le Fichier s'il y en a un !?
        If CheminEtFichier <> "" Then
           Set AttachME = Document.CreateRichTextItem("Attachment")
           Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
        End If
        
        'Envoi le Mail
        Document.SaveMessageOnSend = True 'True svg dans les courriers envoyés
        Document.PostedDate = Now()
        Document.Send 0, AdresDestinataire
        ' suite...
        Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
     End If
    Next
    GoTo FinMail ' fin ##############################################################
    
ErreurNET:
    Msg$ = "Erreur " & Err.Source & "  No " & Err.Number & vbLf & vbLf & Err.Description
    T$ = "Envoi Mail: Problème de connexion !?"
    MsgBox Msg$, vbCritical, T$, Err.HelpFile, Err.HelpContext
    GoTo FinMail
    
FinMail:
    Set oSession = Nothing: Set DataBase = Nothing
    Set Document = Nothing: Set AttachME = Nothing: Set AttachF1 = Nothing
    On Error GoTo 0: Err.Clear
End Sub

sa fonctionne trés bien mais j'ai deux petite question

au lieu dans le corps du message sélectionné une cellule j'aimerais faire en sorte qu'il me sélectionne de A1:D20

Code:
 For j = 1 To 10
            txtbody = Sheets("data").Range("b5")
        Next j
        Document.Body = txtbody


et ma seconde question est comment insérer l'adresse d'un fichier joins sachant que le fichier s'appelle texte qu'il est situé dans le meme répertoire que le claseur xls qui lui se trouvent dans c:
(C:/exel/projet/teste.jpg)

Code:
'Joint le Fichier s'il y en a un !?
        If CheminEtFichier <> "" Then
           Set AttachME = Document.CreateRichTextItem("Attachment")
           Set AttachF1 = AttachME.EmbedObject(1454, "", CheminEtFichier, "Attachment")
        End If

je sais pas si je suis vraiment clair dans mes explications mais je vous remercie d'avance
 

Discussions similaires

Réponses
6
Affichages
268
Réponses
17
Affichages
1 K

Statistiques des forums

Discussions
311 721
Messages
2 081 929
Membres
101 843
dernier inscrit
Thaly