envoyer Uniquement 1 onglet par email

[gothc]

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

 

[Bernard_XLD]

Bonjour gothc, le forum

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

Bien cordialement

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

 

[gothc]

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

 

[Staple1600]

Bonsoir le fil, le forum

gothc
Si tu fais ce test, est-ce qui le chemin et nom fichier sont corrects dans le MsgBox qui s'affiche?

Sub a()
Dim fichier$
fichier = ThisWorkbook.Path & Application.PathSeparator & "j1.xls"
MsgBox fichier
End Sub

 

[gothc]

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

 

[gothc]

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

 

[Bernard_XLD]

Bonjour gothc, Stapple1600, le forum

Je ne me reconnecte que maintenant, donc problème réglé.
La prochaine fois, mets un fichier exemple.

Bien cordialement

 

[gothc]

Bonne journée encore merci de votre aide