Envoi d'un onglet par mail

[thebolino]

Bonjour à tous,

J'ai un fichier en place qui, grâce à une macro, permet un envoi par mail du fichier Excel.

Depuis ce jour, on me demande d'envoyer uniquement l'onglet ouvert et non le classeur entier.
j'ai tenté de changer la ligne concernée en mettant :

ThisWorkbook.Sheets("COMMANDE KNOLL").SaveCopyAs nomfichier

Malheureusement, j'obtiens le message d'erreur suivant : "Erreur d'exécution '438' : Propriété ou méthode non gérée par cet objet "

Voici ma macro initiale :

Sub Envoi_Lotus()

maintenant = Format(Now, "yymmdd-hh-mm")
titre = "Commande mobilier Lotus - " + maintenant
nomfichier = "C:\Users\" + Application.UserName + "\Documents\" + titre + ".xlsm"
ActiveWorkbook.SaveCopyAs nomfichier
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
myItem.to = XXXXXXXX
myItem.cc = XXXXXXXX
myItem.Subject = "Pré-commande de mobilier : " & Range(" C5 ").Value & " / " & Range(" C6 ").Value & ""
Set myattachments = myItem.Attachments
myattachments.Add nomfichier
myattachments(1).Position = 1


myItem.body = "Bonjour," & vbLf & vbLf & "Vous trouverez ci-joint la précommande concernant le site " & Range(" C5 ").Value & " / " & Range(" C6 ").Value & "." & vbLf & vbLf & "Bien cordialement."
myItem.Display
' ActiveWorkbook.Close (False)

End Sub


Merci de votre aide

 

[Tibo62]

Re : Envoi d'un onglet par mail

Bonjour

Tout d'abord utilisez-vous Outlook pour envoyez-vos mails?

Je suppose que oui si c'est le cas voici le code que j'utilisais et il fonctionnait très bien :

Sub Mail_ActiveSheet()
'Working in Excel 2000-2013
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

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

Set Sourcewb = ActiveWorkbook

'Copy the ActiveSheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With

' 'changer les formules de la feuille par leurs valeurs (nombre ou texte)
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "xxxxx@gmail.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close savechanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[thebolino]

Re : Envoi d'un onglet par mail

Merci de votre réponse.

Oui j'utilise Outlook.

Par contre, je ne souhaite pas utiliser un fichier temporaire. L'enregistrement dans "Mes Documents" est voulu.

Depuis ma macro, existe-t-il une modification à apporter pour envoyer uniquement l'onglet et pas le classeur.
Je suis loin d'être un expert en VBA ... et votre macro est très complexe pour moi

Du coup, si on peut conserver ma macro, je suis preneur. C'est une solution de simplicité au niveau des mes compétences en VBA

Merci.

 

[Tibo62]

Re : Envoi d'un onglet par mail

Bonjour à essayer je n'ai pas accès à outlook pour l'instant.

Sub Envoi_Lotus()

Dim nomfichier As String

maintenant = Format(Now, "yymmdd-hh-mm")
titre = "Commande mobilier Lotus - " + maintenant
nomfichier = "C:\Users\" + Application.UserName + "\Documents\" + titre + ".xlsm"
ActiveWorkbook.SaveCopyAs ActiveWorkbook.Path & "\" & nomfichier
Set myOlApp = CreateObject("Outlook.Application")
Set myItem = myOlApp.CreateItem(olMailItem)
myItem.to = XXXXXXXX
myItem.cc = XXXXXXXX
myItem.Subject = "Pré-commande de mobilier : " & Range(" C5 ").Value & " / " & Range(" C6 ").Value & ""
Set myattachments = myItem.Attachments
myattachments.Add nomfichier
myattachments(1).Position = 1


myItem.body = "Bonjour," & vbLf & vbLf & "Vous trouverez ci-joint la précommande concernant le site " & Range(" C5 ").Value & " / " & Range(" C6 ").Value & "." & vbLf & vbLf & "Bien cordialement."
myItem.Display
' ActiveWorkbook.Close (False)

End Sub

 

[thebolino]

Re : Envoi d'un onglet par mail

J'ai un message d'erreur :

Erreur d'exécution '1004' :

"
'C:\Users\xxxxx\Documents\Excel\C:\Users\xxxxx mobilier Lotus - 480216-14-16.xlsm' introuvable. Vérifiez l'orthographe du nom du classeur et la validité de l'emplacement.

Si vous essayez d'ouvrir le fichier à partir de la liste des fichiers les plus récents, assurez-vous que le fichier n'a pas été renommé, déplacé ou supprimé.
"

Logiquement, le fichier doit s'enregistrer dans C:\Users\xxxx\Documents

Merci de ton aide

 

[Tibo62]

Re : Envoi d'un onglet par mail

bonjour,
ce fichier se trouve ou : xxxxx mobilier Lotus - 480216-14-16.xlsm'

Parce que je t'avais indiqué en rouge la ligne qu'il fallait modifier, la c'est un chemin d'accès que j'ai mis n'existe pas bien entendu.
A toi a indiquer le bon chemin je peux pas le faire à ta place sa.

 

[Tibo62]

Re : Envoi d'un onglet par mail

Bon j'ai pu améliorer la macro maintenant on va y ajouter tes besoins personnels mais la tout fonctionne :

Sub envoi_Feuille()
répertoireAppli = ActiveWorkbook.Path
Sheets("Feuil1").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Commande mobilier Lotus.xls"
ActiveWindow.Close
'--- Envoi par email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "XXXXX@gmail.com"
.CC = ""
.BCC = ""
.Subject = "Voici le sujet"
.Body = "Bonjour"
.Attachments.Add ("C:\Commande mobilier Lotus.xls")
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0

End Sub

 

[thebolino]

Re : Envoi d'un onglet par mail

Le lien ou se trouve le fichier est :

"C:\Users\" + Application.UserName + "\Documents\" + titre + ".xlsm"

Ce dernier étant utilisé par plusieurs personnes il est important de l'enregistrer dans le dossier "Documents" de chaque personne.

J'ai essayé avec ta dernière macro mais cela ne fonctionne pas ...

 

[Tibo62]

Re : Envoi d'un onglet par mail

La dernière macro enregistre au même endroit que le fichier source

 

[thebolino]

Re : Envoi d'un onglet par mail

J'ai repris ta dernière macro et je l'ai adapté à mes besoins :

Sub envoi_Lotus()
répertoireAppli = ActiveWorkbook.Path
Sheets("COMMANDE LOTUS").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "C:\Users\" + Application.UserName + "\Documents\Commande mobilier Lotus.xls"
ActiveWindow.Close
'--- Envoi par email
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = "briand.stephanie@matmut.fr"
.CC = "briand.jean-philippe@matmut.fr;pasquet.cedric@matmut.fr;guillaume.jb@matmut.fr"
.BCC = ""
.Subject = "Pré-commande de mobilier : " & Range(" C5 ").Value & " / " & Range(" C6 ").Value & ""
.Body = "Bonjour," & vbLf & vbLf & "Vous trouverez ci-joint la précommande concernant le site " & Range(" C5 ").Value & " / " & Range(" C6 ").Value & "." & vbLf & vbLf & "Bien cordialement."
.Attachments.Add ("C:\Users\" + Application.UserName + "\Documents\Commande mobilier Lotus.xls")
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0

End Sub

Pourtant, j'obtiens le message d'erreur suivant :

Erreur d'exécution '1004'
Fichier inaccessible.

 

[Tibo62]

Re : Envoi d'un onglet par mail

Normal ce chemin n'existe pas : ActiveWorkbook.SaveAs répertoireAppli & "C:\Users\" + Application.UserName + "\Documents\

 

[Tibo62]

Re : Envoi d'un onglet par mail

Utilise ceci la il va juste te demander ou tu veux l'enregistrer :

Dim NomDeMonNouvFichier As String, Dossier As String
Sheets("Feuil1").Copy
Application.DisplayAlerts = False

NomDeMonNouvFichier = "Commande" & "mobilier" & ".xls"
Application.FileDialog(msoFileDialogFolderPicker).Show
Chemin = Application.FileDialog(msoFileDialogFolderPicker).InitialFileName

ActiveWorkbook.SaveAs Filename:=NomDeMonNouvFichier, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False

End Sub

 

[Tibo62]

Re : Envoi d'un onglet par mail

ce qui donnerai ceci :

Sub envoi_Lotus()

Dim NomDeMonNouvFichier As String, Dossier As String,
Sheets("Feuil1").Copy
Application.DisplayAlerts = False
NomDeMonNouvFichier = "Commande" & "mobilier" & ".xls"
Application.FileDialog(msoFileDialogFolderPicker).Show
Chemin = Application.FileDialog(msoFileDialogFolderPicker).InitialFileName

ActiveWorkbook.SaveAs Filename:=NomDeMonNouvFichier, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
'--- Envoi par email

ActiveWorkbook.SendMail "XXXXXXX@gmail.com", "objet", False 'accusé de réception

Workbooks("Commandemobilier.xls" ).Close savechanges:=False

End Sub