Sujet Précédent Sujet Suivant

Envoie multiple de mails via excel avec feuille en PJ

Résolu/Fermé
gabytaine Messages postés 8 Date d'inscription mardi 3 février 2015 Statut Membre Dernière intervention 4 mars 2015 - 3 mars 2015 à 14:45
gabytaine Messages postés 8 Date d'inscription mardi 3 février 2015 Statut Membre Dernière intervention 4 mars 2015 - 4 mars 2015 à 16:20
Bonjour à tous,

NOTE: le message est long mais la plus grande partie n'est que du code ( en italique), n'ayez pas peur de lire.

Ma demande la voici:
Je cherche une maccro ayant les fonctionnalitées suivantes:
-envoyer des mails via un bouton sur excel à différents destinataires avec différentes feuilles d'un même classeur.

Cette phrase est flou je m'explique donc de manière plus simple:
J'ai un classeur de 4 feuilles, une fois remplis je doit envoyer par mail la feuille1 uniquement à la personne N°1, la feuille 2 uniquement à la personne N°2 etc...

Ce que j'aimerais c'est avoir une feuille5 avec un bouton qui lorsqu'une fois cliqué, envoie les 4 mails avec les 4 PJ aux 4 personnes différentes (chacun sa feuille, pas plus).

Ou j'en suis:
Jusqu'ici j'ai reussi à envoyer le classeur entier aux 4 personnes ou envoyer une feuille à une personne uniquement (j'ai essayé de boucler le programme pour qu'il s'execute 4 fois de suite (copier/coller à la suite) en changeant l'adresse mail et le fichier à envoyer mais ca ne fonctionne pas).

Je vous donne donc le code en espèrant qu'il vous sera utile:
Sub Mail_Sheets_Array()
' Works in Excel 97 through Excel 2007.
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
' Using ActiveSheet.Copy creates a new workbook with
' the sheet and the file format is the same as the
' original workbook.
' Copy the worksheet to a new workbook.
Sourcewb.Sheets(Array("feuil1")).Copy
Set Destwb = ActiveWorkbook

' Determine the Excel version and file extension/format.
With Destwb
If Val(Application.Version) < 12 Then
' You are using Excel 97-2003.
FileExtStr = ".xls": FileFormatNum = -4143
Else
' You are using Excel 2007.
' When you use ActiveSheet.Copy to create a workbook,
' you are prompted with a security dialog. If you click No
' in the dialog, then the name of Sourcewb is the same
' as Destwb and you exit the subroutine. You only see this
' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is No in the security dialog."
Exit Sub
Else
Select Case Sourcewb.FileFormat
' Code 51 represents the enumeration for a macro-free
' Excel 2007 Workbook (.xlsx).
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
' Code 52 represents the enumeration for a
' macro-enabled Excel 2007 Workbook (.xlsm).
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
' Code 56 represents the enumeration for a
' a legacy Excel 97-2003 Workbook (.xls).
Case 56: FileExtStr = ".xls": FileFormatNum = 56
' Code 50 represents the enumeration for a
' binary Excel 2007 Workbook (.xlsb).
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' Change all cells in the worksheet to values, if desired.
'' With Destwb.Sheets(1).UsedRange
'' .Cells.Copy
'' .Cells.PasteSpecial xlPasteValues
'' .Cells(1).Select
'' End With
''Application.CutCopyMode = False

'Save the new workbook and then mail it.
TempFilePath = Environ$("temp") & "\"
TempFileName = "plan de prévention " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
For i = 1 To 3
.SendMail "personne.N°1@mail.fr", _
"ici, le sujet du mail"
If Err.Number = 0 Then Exit For
Next i
On Error GoTo 0
.Close SaveChanges:=False
End With

' Delete the file you just sent.
Kill TempFilePath & TempFileName & FileExtStr

With Application
.ScreenUpdating = Truend

.EnableEvents = True
End With
End Sub

Conclu:
Comme vous pouvez le voir il n'y à pas le bouton car lorsque je l'ajoute il me dit que "le end sub est attendu" et je n'arrive pas à l'ajouter, il me met l'erreur à chaque fois quelque soit l'endroit ou je le met (sauf juste en dessous de la déclaration mais pour le coup le bouton ne sert plus a rien ('-_-) )

Pour des raison de confidentialité je ne peux pas fournir le fichier excel mais je pense que la description est maintenant plus clair, une feuille en PJ par personne.

Aussi, je n'ai pas crée ce code, je l'ai repris sur un fichier existant et je l'ai un peu modifié, mes compètences en VBA ne sont pas celles que j'aurais aimé avoir (comprendra qui pourra)c'est pourquoi je vous demanderais si vous me venez en aide de préciser les actions à mener (ex: c'est simple il te manque le End Sub <-- c'est du chinois pour moi ^^ il te manque le End Sub à tel endroit<-- là ok XD je grossi le trait volontairement mais au moins tous le monde comprendra)

Merci aux courageux qui lirons ce message et d'avance merci à celles et ceux qui me feront avancer :)
(si je trouve la solution avant vous, je vous en ferais part car j'ai pu voir sur le net que ce problème concerne beaucoup de personnes)


Au plaisir de vous lire,
A voir également:

1 réponse

Réponse 1 / 1
gabytaine Messages postés 8 Date d'inscription mardi 3 février 2015 Statut Membre Dernière intervention 4 mars 2015 5
Modifié par gabytaine le 4/03/2015 à 11:59
Bonjour à tous,

Alors voila ou j'en suis ^^
J'ai reussi à mettre mon bouton et à réaliser le programme afin d'envoyer la feuil1 à la personne 1.

Tout content je me suis alors dit de "doubler" le programme en réalisant un petit copier/coller à la suite en prenant soin de ne pas redéclarer ce qui a déjà été déclarés et de retirer le "end sub" en trop et la: ca marche !!

A ce moment précis j'ai cru, à tord, avoir trouvé la solution puisque le code marchant pour deux personnes durant les essais je l'ai copier/coller en prettant la même attention qu'au dessus pour l'adapter à l'envoie de 4 mails mais ce fut le drame ^^

Lorsque je lance la maccro via mon bouton l'envoie du mail n°1 ce fait comme prévus, le deuxième également puis "patatrak" une jolie fenêtre s'ouvre et me dit: Erreur d'execution '9' L'indice n'appartient pas à la séléction

J'ai utiliser la maccro style pas à pas (F8) et l'erreur se trouve entre ces deux ligne (la première surligné en jaune, puis F8 -->crash):

Sourcewb.Sheets(Array("feuil3")).Copy
Set Destwb = ActiveWorkbook

Je me suis renseigné sur cette erreur et il s'avère que j'utilise 4 fois la même fonction/maccro avec le même nom (car copier/coller) et cela semble créer un conflit. Mais pourquoi le programme plante sur le 3eme mail et pas le 2eme??? Car, je me repète, j'ai copier/coller le même programme 3fois pour atteindre 4 mail.

J'ai un réel besoin d'aide, je le copie/colle en entier ci dessous: 

Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Feuil7.Mail_Sheets_Array
End Sub


Sub Mail_Sheets_Array()
' Works in Excel 97 through Excel 2007.
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String

With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
' Utiliser Sourcewb.Sheets(Array("feuil1")).Copy pour créer
' un nouveau classeur avec
' les mêmes feuilles que selectionné aux format du
' classeur d'origine.
' Copier le classeur dans un nouveau classeur.
Sourcewb.Sheets(Array("feuil1")).Copy
Set Destwb = ActiveWorkbook

' Determine la version Excel et l'extension/format des fichiers.
With Destwb
   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      ' You are using Excel 2007.
      ' When you use ActiveSheet.Copy to create a workbook,
      ' you are prompted with a security dialog. If you click No
      ' in the dialog, then the name of Sourcewb is the same
      ' as Destwb and you exit the subroutine. You only see this
      ' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
      If Sourcewb.Name = .Name Then
         With Application
            .ScreenUpdating = True
            .EnableEvents = True
         End With
         MsgBox "Your answer is No in the security dialog."
         Exit Sub
      Else
         Select Case Sourcewb.FileFormat
            ' Code 51 represents the enumeration for a macro-free
            ' Excel 2007 Workbook (.xlsx).
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            ' Code 52 represents the enumeration for a
            ' macro-enabled Excel 2007 Workbook (.xlsm).
            Case 52:
               If .HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
               End If
            ' Code 56 represents the enumeration for a
            ' a legacy Excel 97-2003 Workbook (.xls).
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            ' Code 50 represents the enumeration for a
            ' binary Excel 2007 Workbook (.xlsb).
             Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
   End If
End With

' Change all cells in the worksheet to values, if desired.
''   With Destwb.Sheets(1).UsedRange
''      .Cells.Copy
''      .Cells.PasteSpecial xlPasteValues
''      .Cells(1).Select
''   End With
''Application.CutCopyMode = False

'Sauvegarder le nouveau fichier et le mettre dans le mail.
   TempFilePath = Environ$("temp") & "\"
   TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
   .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
      On Error Resume Next
      For i = 1 To 3
         .SendMail "personne.1@mail.fr", _
            "fichier 1"
            If Err.Number = 0 Then Exit For
      Next i
      On Error GoTo 0
   .Close SaveChanges:=False
End With
 
' suppresion de l'element envoyé.
Kill TempFilePath & TempFileName & FileExtStr

With Application
   .ScreenUpdating = Truend
   
   .EnableEvents = True
End With
 
' 1ere boucle
' on remet le mm code sans les déclarations
' et on change juste le fichier a envoyer
' et l'adresse mail du destinataire

With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
' Utiliser Sourcewb.Sheets(Array("feuil1")).Copy pour créer
' un nouveau classeur avec
' les mêmes feuilles que selectionné aux format du
' classeur d'origine.
' Copier le classeur dans un nouveau classeur.
Sourcewb.Sheets(Array("feuil2")).Copy
Set Destwb = ActiveWorkbook

' Determine la version Excel et l'extension/format des fichiers.
With Destwb
   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      ' You are using Excel 2007.
      ' When you use ActiveSheet.Copy to create a workbook,
      ' you are prompted with a security dialog. If you click No
      ' in the dialog, then the name of Sourcewb is the same
      ' as Destwb and you exit the subroutine. You only see this
      ' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
      If Sourcewb.Name = .Name Then
         With Application
            .ScreenUpdating = True
            .EnableEvents = True
         End With
         MsgBox "Your answer is No in the security dialog."
         Exit Sub
      Else
         Select Case Sourcewb.FileFormat
            ' Code 51 represents the enumeration for a macro-free
            ' Excel 2007 Workbook (.xlsx).
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            ' Code 52 represents the enumeration for a
            ' macro-enabled Excel 2007 Workbook (.xlsm).
            Case 52:
               If .HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
               End If
            ' Code 56 represents the enumeration for a
            ' a legacy Excel 97-2003 Workbook (.xls).
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            ' Code 50 represents the enumeration for a
            ' binary Excel 2007 Workbook (.xlsb).
             Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
   End If
End With

' Change all cells in the worksheet to values, if desired.
''   With Destwb.Sheets(1).UsedRange
''      .Cells.Copy
''      .Cells.PasteSpecial xlPasteValues
''      .Cells(1).Select
''   End With
''Application.CutCopyMode = False

'Sauvegarder le nouveau fichier et le mettre dans le mail.
   TempFilePath = Environ$("temp") & "\"
   TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
   .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
      On Error Resume Next
      For i = 1 To 3
         .SendMail "personne.2@mail.fr", _
            "fichier2"
            If Err.Number = 0 Then Exit For
      Next i
      On Error GoTo 0
   .Close SaveChanges:=False
End With
 
' suppresion de lelement envoyé.
Kill TempFilePath & TempFileName & FileExtStr

With Application
   .ScreenUpdating = Truend
   
   .EnableEvents = True
End With
' 2eme boucle
' on remet le mm code sans les déclarations
' et on change juste le fichier a envoyer
' et l'adresse mail du destinataire

With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
' Utiliser Sourcewb.Sheets(Array("feuil1")).Copy pour créer
' un nouveau classeur avec
' les mêmes feuilles que selectionné aux format du
' classeur d'origine.
' Copier le classeur dans un nouveau classeur.
Sourcewb.Sheets(Array("feuil3")).Copy
Set Destwb = ActiveWorkbook

' Determine la version Excel et l'extension/format des fichiers.
With Destwb
   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      ' You are using Excel 2007.
      ' When you use ActiveSheet.Copy to create a workbook,
      ' you are prompted with a security dialog. If you click No
      ' in the dialog, then the name of Sourcewb is the same
      ' as Destwb and you exit the subroutine. You only see this
      ' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
      If Sourcewb.Name = .Name Then
         With Application
            .ScreenUpdating = True
            .EnableEvents = True
         End With
         MsgBox "Your answer is No in the security dialog."
         Exit Sub
      Else
         Select Case Sourcewb.FileFormat
            ' Code 51 represents the enumeration for a macro-free
            ' Excel 2007 Workbook (.xlsx).
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            ' Code 52 represents the enumeration for a
            ' macro-enabled Excel 2007 Workbook (.xlsm).
            Case 52:
               If .HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
               End If
            ' Code 56 represents the enumeration for a
            ' a legacy Excel 97-2003 Workbook (.xls).
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            ' Code 50 represents the enumeration for a
            ' binary Excel 2007 Workbook (.xlsb).
             Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
   End If
End With

' Change all cells in the worksheet to values, if desired.
''   With Destwb.Sheets(1).UsedRange
''      .Cells.Copy
''      .Cells.PasteSpecial xlPasteValues
''      .Cells(1).Select
''   End With
''Application.CutCopyMode = False

'Sauvegarder le nouveau fichier et le mettre dans le mail.
   TempFilePath = Environ$("temp") & "\"
   TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
   .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
      On Error Resume Next
      For i = 1 To 3
         .SendMail "personne.3@mail.fr", _
            "fichier3"
            If Err.Number = 0 Then Exit For
      Next i
      On Error GoTo 0
   .Close SaveChanges:=False
End With
 
' suppresion de lelement envoyé.
Kill TempFilePath & TempFileName & FileExtStr

With Application
   .ScreenUpdating = Truend
   
   .EnableEvents = True
End With
' 3eme boucle
' on remet le mm code sans les déclarations
' et on change juste le fichier a envoyer
' et l'adresse mail du destinataire

With Application
   .ScreenUpdating = False
   .EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
' Utiliser Sourcewb.Sheets(Array("feuil1")).Copy pour créer
' un nouveau classeur avec
' les mêmes feuilles que selectionné aux format du
' classeur d'origine.
' Copier le classeur dans un nouveau classeur.
Sourcewb.Sheets(Array("feuil4")).Copy
Set Destwb = ActiveWorkbook

' Determine la version Excel et l'extension/format des fichiers.
With Destwb
   If Val(Application.Version) < 12 Then
      ' You are using Excel 97-2003.
      FileExtStr = ".xls": FileFormatNum = -4143
   Else
      ' You are using Excel 2007.
      ' When you use ActiveSheet.Copy to create a workbook,
      ' you are prompted with a security dialog. If you click No
      ' in the dialog, then the name of Sourcewb is the same
      ' as Destwb and you exit the subroutine. You only see this
      ' dialog when you attempt to copy a worksheet from an .xlsm file with macros disabled.
      If Sourcewb.Name = .Name Then
         With Application
            .ScreenUpdating = True
            .EnableEvents = True
         End With
         MsgBox "Your answer is No in the security dialog."
         Exit Sub
      Else
         Select Case Sourcewb.FileFormat
            ' Code 51 represents the enumeration for a macro-free
            ' Excel 2007 Workbook (.xlsx).
            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
            ' Code 52 represents the enumeration for a
            ' macro-enabled Excel 2007 Workbook (.xlsm).
            Case 52:
               If .HasVBProject Then
                  FileExtStr = ".xlsm": FileFormatNum = 52
               Else
                  FileExtStr = ".xlsx": FileFormatNum = 51
               End If
            ' Code 56 represents the enumeration for a
            ' a legacy Excel 97-2003 Workbook (.xls).
            Case 56: FileExtStr = ".xls": FileFormatNum = 56
            ' Code 50 represents the enumeration for a
            ' binary Excel 2007 Workbook (.xlsb).
             Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
         End Select
      End If
   End If
End With

' Change all cells in the worksheet to values, if desired.
''   With Destwb.Sheets(1).UsedRange
''      .Cells.Copy
''      .Cells.PasteSpecial xlPasteValues
''      .Cells(1).Select
''   End With
''Application.CutCopyMode = False

'Sauvegarder le nouveau fichier et le mettre dans le mail.
   TempFilePath = Environ$("temp") & "\"
   TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

With Destwb
   .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
      On Error Resume Next
      For i = 1 To 3
         .SendMail "personne.4@mail.fr", _
            "fichier4"
            If Err.Number = 0 Then Exit For
      Next i
      On Error GoTo 0
   .Close SaveChanges:=False
End With
 
' suppresion de lelement envoyé.
Kill TempFilePath & TempFileName & FileExtStr

With Application
   .ScreenUpdating = Truend
   
   .EnableEvents = True
End With
 End Sub
0
gabytaine Messages postés 8 Date d'inscription mardi 3 février 2015 Statut Membre Dernière intervention 4 mars 2015 5
4 mars 2015 à 16:20
Re,

Cette fois sa fonctionne,
Donc pour la solution j'ai supprimé la partie "2eme boucle" qui crashée et j'ai testé la maccro avec 3 mails, ca a fonctionné donc j'ai copier/coller la dernière boucle, modifier l'adresse mail et la PJ (pièce jointe) et cette fois les 4 mails partent ^^

Me demandez pas pourquoi cette fois ca marche alors que c'est le même code, je n'en sais rien peut être ai je mal réalisé mon premier copier/coller toujours est-il que ca marche (je l'ai testé 5fois de suite, ma boite mail va imploser XD)

En espérant que mon monologue serve à quelqu'un un de ces jours,

Gabriel,

PS: mon problème étant résolu je suis sencé fermer ce topic mais j'aimerais maintenant "optimiser" mon code car il est très (trop?) grand et je sais que certaines ligne me sont inutil. Je ne cloture pas cette question tout de suite en espèrant qu'une âme charitable m'aide à simplifier tous ca. Si personne ne viens par ici d'ici vendredi 6 mars je clotuerai ;)
0

Discussions similaires

Feuille de score belote
nulleeninfo -
brucine -

7 réponses