Envoi feuilles par mail

  • Initiateur de la discussion Initiateur de la discussion anber
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

anber

XLDnaute Occasionnel
Bonjour le forum,

J'ai récupéré ce code (qui fonctionne super) pour l'envoi une à une des feuilles d'un classeur :
Je souhaiterai envoyer certaines feuilles à plusieurs destinataires, et d'autres qu'à un seul.
Quelqu'un pourrai-t-il m'aider à faire évoluer ce code en le rendant plus "ouvert" ?
Comment éviter le test d'outlook ?
Merci par avance

Sub Mail_send()
'Working in 97-2007
Dim wb As Workbook
Dim Shname As Variant
Dim Addr As Variant
Dim N As Integer
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long

Shname = Array("CP", "FJ", "FP")
Addr = Array("cp@toto.com", "fj@toto.com", "fp@toto.com")

If Val(Application.Version) >= 12 Then
'You run Excel 2007
FileExtStr = ".xlsm": FileFormatNum = 52
Else
'You run Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
End If

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

TempFilePath = Environ$("temp") & "\"

'Create the new workbooks/Mail it/Delete it
For N = LBound(Shname) To UBound(Shname)

TempFileName = "Devis" & Shname(N) & " " & Format(Now, "dd-mmm-yy h-mm-ss")

ThisWorkbook.Sheets(Shname(N)).Copy
Set wb = ActiveWorkbook

With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormatNum
On Error Resume Next
.SendMail Addr(N), _
"Devis"
On Error Resume Next
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Next N

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
477
Réponses
5
Affichages
2 K
Réponses
6
Affichages
626
Retour