VBA Excel : Macro mail avec PJ + Archivage

Edaine Messages postés 63 Statut Membre -  
Edaine Messages postés 63 Statut Membre -
Bonjour,

Je dispose d'un fichier avec plusieurs feuilles dont il faut envoyer une seule par mail.

J'aimerai n'envoyer qu'une seule feuille par mail à une plage de destinataire prédéfinis et listé dans une autre feuille.
Une fois le mail envoyé j'aimerai que ma macro fasse appel à une autre macro "d'archivage", j'aimerai que cette dernière macro fasse en sorte d'enregistrer ma feuille dans un classeur défini en y ajoutant simplement une feuille.

Je disposai déjà d'une macro "mail" dont j'ai tenté la modification en vain...
Je ne maitrise pas les macros et je ne connais pas les "attributions" à indiquer pour mettre une seule feuille en pièce jointe dans le cas de ce mail
la voici :

Sub Mail1()
   

    Application.ScreenUpdating = False
    
    Dim MonOutlook As Object
    Dim MonMessage As Object
    Dim Destinataires As String
 
        Set MonOutlook = CreateObject("Outlook.Application")
        Set MonMessage = MonOutlook.createitem(0)
        
        Destinataire = "***@***.com"
        MonMessage.To = Destinataire
        
 ThisWorkbook.Sheets("FL").Copy
 
 With Sheets("FL")
 
        MonMessage.Subject = "***"
        MonMessage.Body = "Bonjour," & vbCrLf & vbCrLf _
                    & "Veuillez trouvez ci-joint*****" & vbCrLf & vbCrLf _
                    & "Cordialement " & vbCrLf _
                 
    
        MonMessage.display
           
        Set MonOutlook = Nothing
 End With
 
 ActiveWorkbook.Close
 
        Application.ScreenUpdating = True
        
        
End Sub


En ce qui concerne la macro d'archivage, je n'arrive pas du tout à indiquer qu'il faut enregistré dans un fichier défini la feuille et ne pas enregistrer un nouveau classeur à chaque fois..

Voilà, la deuxième macro est moins importante. je peux toujours au pire enregistrer un classeur à chaque fois dans un dossier défini.

En vous remerciant d'avance,

Edaine

2 réponses

  1. eljojo_e Messages postés 1255 Statut Membre 155
     
    bonjour,

    un code de mail qui marche avec thunderbird :

    Sub CmdPEmail()

    dossier = "C:\Program Files\Mozilla Thunderbird"
    dossier2 = Len(Dir(dossier, vbDirectory))
    If dossier2 <> 0 Then
    Else
    MsgBox ("La messagerie 'Mozilla Thunderbird' n'a pas été trouvé dans" & vbLf & vbLf & dossier)
    GoTo a:
    End If

    Dim dlgOpen As FileDialog
    Dim FichierSélectionné As Variant

    'joindre un/plusieurs fichier(s)

    Select Case MsgBox("Joindre des fichiers au mail ???", vbInformation + vbYesNo, "Joindre fichiers")
    Case vbYes
    azf = ""
    Set dlgOpen = Application.FileDialog(msoFileDialogOpen)
    With dlgOpen
    '.InitialFileName = tr 'pour répertoire racine par exemple
    .Show
    .Title = "Joindre un/des fichiers au mail"
    For Each FichierSélectionné In .SelectedItems
    If FichierSélectionné <> "" Then azf = azf & "," & FichierSélectionné
    Next
    End With
    If IsNull(azf) Or azf = "" Then
    Else
    azf = Right(azf, Len(azf) - 1)
    End If
    Case vbNo
    End Select

    Set OuvrirFichier = Nothing
    Set dlgOpen = Nothing

    Sujet = "Ecrire un sujet"
    Msg = "Texte"

    Dim a, b
    b = ""

    ' A adapter suivant ta liste de destinataire.
    For a = 4 To 188

    If Sheets("Mailing").Range("m" & a).Value <> "" Then

    b = b & Sheets("Mailing").Range("m" & a).Value & ","
    Else
    If b = "" Then Exit Sub

    End If

    Next

    qui = "'" & b & "'"

    toto = dossier & "\thunderbird -compose attachment=" & "'" & azf & "'" & ",body=" & Msg & ",subject=" & Sujet & ",to=" & qui ''C:\temp\info.doc,C:\temp\food.doc'
    Call Shell(toto)

    a:

    End Sub
    0
  2. Edaine Messages postés 63 Statut Membre
     
    Merci pour la macro,

    Néanmoins, je ne dispose pas de Thunderbird mais d'Outlook 2003 :s

    Et je ne vois pas comment l'adapter à outlook 2003 ..
    0