envoyer Uniquement 1 onglet par email

  • Initiateur de la discussion Initiateur de la discussion gothc
  • 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 !

gothc

XLDnaute Occasionnel
Bonjour dans cette Macro j'envoi mon fichier complet J1.xls je cherche juste a faire la même chose mais que l'onglet planning2017
Merci de votre aide

Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object, iConf As Object, strbody$, Fichier$
Dim Flds As Variant, SourceWb As Workbook, t, Destinataires$
Set SourceWb = ActiveWorkbook
Fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"
SourceWb.SaveCopyAs Fichier
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("") = True
.Item("") = 1
.Item("") = "01@gmail.com"
.Item("") = "passe"
.Item("") = "smtp.gmail.com"
.Item("") = 2
.Item("") = 465
.Update
End With
t = Range("A1:A15")
Destinataires = Join(Application.Transpose(t), ";")
strbody = "Bonjour, Voici le fichier . Merci!"
With iMsg
Set .Configuration = iConf
.to = "01@gmail.com"
.CC = Destinataires
.BCC = ""
.From = """MR "" <email>"
.Subject = "fichier"
.TextBody = strbody
.AddAttachment Fichier
.Send
Kill Fichier
End With
End Sub
 
Bonjour gothc, le forum

petite modif rapide, on crée un nouveau classeur avec la feuille concernée par l'envoi

Bien cordialement

Code:
Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object, iConf As Object, strbody$, Fichier$
Dim Flds As Variant, t, Destinataires$

Fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"
ActiveWorkbook.Sheets("planning2017").Copy
ActiveWorkbook.SaveAs Filename:=Fichier

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "01@gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "passe"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Update
End With
t = Range("A1:A15")
Destinataires = Join(Application.Transpose(t), ";")
strbody = "Bonjour, Voici le fichier . Merci!"
With iMsg
Set .Configuration = iConf
.to = "01@gmail.com"
.CC = Destinataires
.BCC = ""
.From = """MR "" <email>"
.Subject = "fichier"
.TextBody = strbody
.AddAttachment Fichier
.Send
Kill Fichier
End With
End Sub
 
Sub CDO_Mail_Small_Text_2()
Dim iMsg As Object, iConf As Object, strbody$, Fichier$
Dim Flds As Variant, t, Destinataires$

Fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"
ActiveWorkbook.Sheets("planning2017").Copy
ActiveWorkbook.SaveAs Filename:=Fichier

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds

bonsoir le fil
j'ai une erreur sur la ligne en rouge merci
 
Bonjour le fil j'ai plus d'erreur sur le chemin du fichier mais sur la ligne en rouge .AddAttachment Fichier
merci de votre aide

With iMsg
Set .Configuration = iConf
.to = "01@gmail.com;ch@gmail.com"
.CC = Destinataires
.BCC = ""
.From = """MR "" <email>"
.Subject = "fichier"
.TextBody = strbody
.AddAttachment Fichier
.Send
Kill Fichier
End With
End Sub
 
bonjour j'ai trouvé pourquoi . le fichier est ouvert donc impossible d'envoyer un fichier ouvert
j'ai fait une modification qui fonctionne Merci bonne journée

Fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"
ActiveWorkbook.Sheets("planning2017").Copy
ActiveWorkbook.SaveAs Filename:=Fichier
Workbooks("j1.xls").Close True
 
- 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

  • Question Question
Réponses
1
Affichages
584
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
817
Réponses
5
Affichages
2 K
Retour