Excel macro mail automatique

Zlatan -  
 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

  1. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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
  2. lermite222 Messages postés 9042 Statut Contributeur 1 199
     
    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
  3. Polux31 Messages postés 7219 Statut Membre 1 204
     
    Bonjour,

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

    Mais au cas où !!!

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

    Ôo
    0
  4. 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 !).
    0
    1. Polux31 Messages postés 7219 Statut Membre 1 204
       
      Tu veux dire que tu as cette macro dans tous les fichiers Excel ???

      Elle est enregistrée où cette macro ???
      0
    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 ?
      0
  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. Polux31 Messages postés 7219 Statut Membre 1 204
     
    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)
    0
  7. 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.
    0
    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).
      0
    2. Zlatan
       
      De plus l'envoie du mail à une durée de 1h voir deux !
      0