Excel macro mail automatique

Zlatan -  
Bonjour,
voici mon problème, j'ai une macro qui envoie automatiquement mon fichier excel aux addresse mails que j'ai donner. Le souci est le suivant le "main" de ma macro est là suivante : 
Sub Envoi()
    Dim Sujet As String, Corps As String, Desti As String
    Dim CC As String, c As Range, PJ As String
    Sujet = "multi envoie"
    Corps = "test à envoie de multi destinnataire"
    CC = ""
    Desti = "x@x;x@x"
    PJ = "D:\documents and Settings\lol\Desktop\nom_du_fichier_excel.xls"
    SendNotesMail Sujet, Corps, Desti, CC, PJ
End Sub


Voilà c'est içi qu'est mon problème, je souhaite faire en sorte que sur la ligne Pj, je ne soit pas obliger de mettre le lien de mon fichier excel. Mais, quand j'ouvre le fichier excel, et qu'il me convient, je lance la macro, et il s'envoie automatiquement. Sans que j'ai a modifier ce PJ avec le lien de mon fichier excel, j'espère m'être fait comprendre, et merci d'avance !

6 réponses

  • Votes
  • Date
  • Date décroissante
  1. lermite222 Contributeur
    Bonjour,
    Si j'ai bien compris... 
    Sub Envoi() 
    Dim Sujet As String, Corps As String, Desti As String 
    Dim CC As String, c As Range, PJ As String, Num As Integer 
    If Application.Workbooks.Count > 1 Then 
        'au moins deux classeurs ouvert 
        Sujet = "multi envoie" 
        Corps = "test à envoie de multi destinnataire" 
        CC = "" 
        Desti = "x@x;x@x" 
        'prend le path et nom de l'autre classeur 
        If Workbooks(1).Name = ThisWorkbook.Name Then Num = 2 Else Num = 1 
        PJ = Workbooks(Num).Path & "\" & Workbooks(Num).Name 
        SendNotesMail Sujet, Corps, Desti, CC, PJ 
    Else 
        MsgBox "pas de classeur disponnible" 
    End If 
End Sub


    A+
    L'expérience instruit plus sûrement que le conseil. (André Gide)
    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
    1. lermite222 Contributeur
      Er éventuellement si tu a ouvert plusieurs classeurs et que tu veux tous les envoyer d'un coup... 
      Sub EnvoiMulti()
Dim Sujet As String, Corps As String, Desti As String
Dim CC As String, c As Range, PJ As String, Num As Integer
Dim Wk As Workbook
    If Application.Workbooks.Count > 1 Then
        'au moins deux classeurs ouvert
        Sujet = "multi envoie"
        Corps = "test à envoie de multi destinnataire"
        CC = ""
        Desti = "x@x;x@x"
        'Envoi automatique de plusieurs classeurs
        For Each Wk In Workbooks
            If Wk.Name <> ThisWorkbook.Name Then
                PJ = Wk.Path & "\" & Wk.Name
                SendNotesMail Sujet, Corps, Desti, CC, PJ
            End If
        Next Wk
    Else
        MsgBox "pas de classeur disponnible"
    End If
End Sub

      1.  Polux31
        Bonjour,

        Désolé mais je n'ai pas compris.

        Mais au cas où !!!

        PJ = ThisWorkbook.Path & "\" & ThisWorkbook.Name

        Ôo
        1. Zlatan
          Non cela ne fonctionne pas.

          Pour simplifier, j'ai mon fichier excel et je lance une macro sur ce fichier, pour l'envoyer en automatique à des adresse mail(sans passer par ma boite mail).
          tout est bon pour le moment !

          Seulement quand j'ouvre un autre fichier excel, et que je lance la macro, là elle m'envoie le 1 fichier excel vu que je l'ai enregistrer à cette ligne là : 
          PJ = "D:\documents and Settings\lol\Desktop\nom_du_fichier_excel.xls"


          Qui vas donc rechercher le fichier à envoyer. Et moi ce que je souhaite, c'est lorsque j'ouvre un fichier excel, et quand je lance la macro, que se soit CE fichier excel qui s'envoie (que je n'ai pas a modifier le code de la macro a chaque fichier différents !).
          1. Polux31
            Tu veux dire que tu as cette macro dans tous les fichiers Excel ???

            Elle est enregistrée où cette macro ???
          2. Zlatan
            non elle n'est pas enrengistrer dans tout les fichiers, je suis obliger de l'ouvrir elle est dans un dossier a part ou je regroupe les quelques macro que j'ai fais. Serais-ce là le problème ?
        3. Polux31
          Bonjour Zlatan, bonjour lermite

          Je crois comprendre que les macros sont enregistrées dans des classeurs sauvegardés dans un répertoire.

          Si c'est le cas, il faut passer le nom du fichier en paramètre dans la procédure Envoi: 
          Sub Envoi(ByVal PJ As String)
    Dim Sujet As String, Corps As String, Desti As String
    Dim CC As String, c As Range
    Sujet = "multi envoie"
    Corps = "test à envoie de multi destinnataire"
    CC = ""
    Desti = "x@x;x@x"
    SendNotesMail Sujet, Corps, Desti, CC, PJ
End Sub


          Et dans le classeur qui appelle la macro: 

          Sub EnvoiMail()
Dim PJ As String

    PJ = ThisWorkBook.Path & "\" & ThisWorkBook.Name

    'Remplacer "C:\Temp\data\monClasseurMacro.xls!Envoi" par le chemin complet et le nom du classeur contenant la macro.
    Application.Run("C:\Temp\data\monClasseurMacro.xls!Envoi", PJ)

End Sub


          :o)
          1. Zlatan
            Bonjour, Polux31,lermite222,

            merci pour vos aide, alors pour lermite222, ce code m'a l'air for intéressant, je viens de l'essayer, au niveau du code tout est bon, mais cela fais 10 minute, et je n'ai pas reçu le mail avec le fichier excel (peut-être est-ce trop long Oo).
            Pour polux31, cela ne fonctionne pas quand je tente de l'insérer, mais cela ne fonctionne pas.
            1. Zlatan
              Voiçi mon code pour le moment :

              Sub Envoi()
              Dim Sujet As String, Corps As String, Desti As String
              Dim CC As String, c As Range, PJ As String, Num As Integer
              If Application.Workbooks.Count > 1 Then
              'au moins deux classeurs ouvert
              Sujet = "dernier test"
              Corps = "envoie final à plusieurs personnes"
              CC = ""
              Desti = "xx@xx"
              'prend le path et nom de l'autre classeur
              If Workbooks(1).Name = ThisWorkbook.Name Then Num = 2 Else Num = 1
              PJ = Workbooks(Num).Path & "\" & Workbooks(Num).Name
              SendNotesMail Sujet, Corps, Desti, CC, PJ
              Else
              MsgBox "pas de classeur disponnible"
              End If
              End Sub

              Public Sub SendNotesMail(Sujet, Corps, Desti, CC, PJ)
              'Set up the objects required for Automation into lotus notes
              Dim Maildb As Object 'The mail database
              Dim UserName As String 'The current users notes name
              Dim Corps_Msg As String ' text du courriel
              Dim MailDbName As String 'THe current users notes mail database name
              Dim MailDoc As Object 'The mail document itself
              Dim AttachME As Object 'The attachment richtextfile object
              Dim Session As Object 'The notes session
              Dim EmbedObj As Object 'The embedded object (Attachment)
              'Start a session to notes
              Set Session = CreateObject("Notes.NotesSession")
              'Next line only works with 5.x and above. Replace password with your

              ' Session.Initialize ("password" )
              'Get the sessions username and then calculate the mail file name
              'You may or may not need this as for MailDBname with some systems you
              'can pass an empty string or using above password you can use other

              ''MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) -

              ''UserName = Session.UserName

              ''SearchString = Recipient
              ''SearchChar = "@"
              ''MyPos = InStr(1, SearchString, SearchChar, vbTextCompare)
              ''Destinataire = Left(SearchString, MyPos - 1)
              'Open the mail database in notes
              Set Maildb = Session.GETDATABASE("", "")
              If Maildb.IsOpen = True Then
              'Already open for mail
              Else
              Maildb.OPENMAIL
              End If
              'Set up the new mail document
              Set MailDoc = Maildb.CREATEDOCUMENT
              MailDoc.Form = "Memo"
              MailDoc.sendto = Desti
              MailDoc.Subject = Sujet
              MailDoc.copyto = CC
              'MailDoc.Body = Corps
              Set MailCorps = MailDoc.CREATERICHTEXTITEM("Body")

              With MailCorps
              .ADDNEWLINE 1
              .APPENDTEXT Corps
              .ADDNEWLINE 2
              End With

              MailDoc.SAVEMESSAGEONSEND = True
              'Set up the embedded object and attachment and attach it
              Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
              'AttachME.AppendText "toto"
              Call AttachME.EMBEDOBJECT(1454, "", PJ, "Attachment")

              'Send the document
              MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items

              MailDoc.Send 0
              'Clean Up
              Set Maildb = Nothing
              Set MailDoc = Nothing
              Set AttachME = Nothing
              Set Session = Nothing
              Set EmbedObj = Nothing

              End Sub

              En gros, cela fonctionne lorsque l'envoie à un seul destinataire, mais lorsque j'en envoie à un autre + moi même cela ne fonctionne pas. (je n'ai pas encore test à envoyer que à plusieurs personnes excepté moi).
            2. Zlatan
              De plus l'envoie du mail à une durée de 1h voir deux !