XL 2016 VBA- Créer copie d'une plage de cellule dans nouveau classeur et envoyer par mail

MONTREAL2020

XLDnaute Junior
Bonjour,

Peu de connaissances en VBA, je voulais faire ce qui suit:
Dans une feuille précise d'un classeur ouvert
- Créer un nouveau classeur
- Copier une plage de cellules depuis le classeur initial vers le nouveau classeur en gardant la mise en forme mais sans les formules
- Lui donner un nom et le sauvegarder dans un dossier (X)
- Faire appel au nouveau classeur
- Envoyer le classeur par email
- Fermer le classeur crée

Voila

J'ai trouvé un Code en cherchant sur le net, mais ca ne marche pas , ca bloque sur (.Send)

Merci par avance pour votre support

En PJ un exemple de fichier

1653421141623.png
 

Pièces jointes

  • RÉCAP 1.xlsm
    29.8 KB · Affichages: 10
Solution
Bonsoir à toutes & à tous, bonsoir @MONTREAL2020
Bon ton sujet n'inspire pas les foules. Il faut dire que l'envoi de mails grâce à CDO n'est pas inné.
Dans l'exemple que je te fournis j'ai mis deux services d'expédition au choix Outlook ou CDO.
Pour CDO, cela ne fonctionne pas dans tous les cas. J'ai testé free.fr et laposte.net qui sont OK mais aussi gmail.com qui ne fonctionne pas ... sans doute un problème de sécurité.

Sur ton exemple j'ai nommé les plages de cellules qui servent à la macro
NomsAdresseUtilisation
Plage_Mail=RÉCAP!$B$2:$P$12la plage de cellules à envoyer en PJ
Destinataires=t_destinatairesun tableau pour choisir...

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonsoir à toutes & à tous, bonsoir @MONTREAL2020
Bon ton sujet n'inspire pas les foules. Il faut dire que l'envoi de mails grâce à CDO n'est pas inné.
Dans l'exemple que je te fournis j'ai mis deux services d'expédition au choix Outlook ou CDO.
Pour CDO, cela ne fonctionne pas dans tous les cas. J'ai testé free.fr et laposte.net qui sont OK mais aussi gmail.com qui ne fonctionne pas ... sans doute un problème de sécurité.

Sur ton exemple j'ai nommé les plages de cellules qui servent à la macro
NomsAdresseUtilisation
Plage_Mail=RÉCAP!$B$2:$P$12la plage de cellules à envoyer en PJ
Destinataires=t_destinatairesun tableau pour choisir des destinataires
Destinataire=RÉCAP!$C$15le destinataire choisi
Service=RÉCAP!$N$20le choix entre Outlook et CDO
Expéditeur=RÉCAP!$S$8l'adresse mail de l'expéditeur (pour CDO)
MotDePasse=RÉCAP!$S$10le mot de passe de l'expéditeur (pour CDO)
ServeurSMTP=RÉCAP!$S$12le serveur SMTP de l'herbergeur (pour CDO)

La macro principale:
Enrichi (BBcode):
Sub EnvoiMessage()
     Dim Source As Range, Wbk As Workbook, Cible As Range, FS As Object
     Dim Service$, Objet$, Corps$, Signature$, Destinataire$, Expéditeur$, ServeurSMTP$, Motdepasse$, NomFich$
    
     'Création de la pièce jointe
     Application.ScreenUpdating = False
     Set Source = ThisWorkbook.Worksheets("RÉCAP").[Plage_Mail]
     Set Wbk = Workbooks.Add
     Set Cible = Wbk.Worksheets(1).[A1].Resize(Source.Rows.Count, Source.Columns.Count)
     Source.Copy Destination:=Cible
     Cible.Value = Cible.Value            'Transformer les formules en valeurs
    
     'Enregistrement dans le répertoire temporaire
     Set FS = CreateObject("Scripting.FileSystemObject")
     Nom = FS.GetbaseName(ThisWorkbook.FullName)    
     TempFileName = "Recap Jour «" & Nom & "» " & Format(Now, "dd-mmm-yy")
     TempPath = Environ$("temp") & "\"
     Wbk.SaveAs TempPath & TempFileName, FileFormat:=xlOpenXMLWorkbook
     NomFich = Wbk.FullName
     Wbk.Close
    
     Application.ScreenUpdating = True

     'Données du message
     With ThisWorkbook.Worksheets("RÉCAP")
          Service = .[Service]
          Expéditeur = .[Expéditeur]
          Destinataire = .[Destinataire]
          ServeurSMTP = .[ServeurSMTP]
          Motdepasse = .[Motdepasse]
     End With
    
     'A adapter   
    '¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
     Objet = "Récapitulatif du " & Format(Now, "dd/mm/yyyy")
     Signature = "Mr xxxxxxxxxx" & vbCrLf & "Responsable xxxxxxxxx"
     Corps = "Bonjour," & vbCrLf & "je vous pris de bien vouloir recevoir le mail de la recap du jour," & vbCrLf & "cordialement" & vbCrLf & Signature
    '¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ 
     'Envoi du mail choix Outlook, CDO
     Select Case Service
     Case "Outlook"
          OLK_Mail Destinataire, Objet, Corps, NomFich
     Case "CDO"
          CDO_Mail Expéditeur, ServeurSMTP, Motdepasse, Destinataire, Objet, Corps, NomFich
    End Select
    
     Kill NomFich
    
End Sub

La macro d'envoi via Outlook
Enrichi (BBcode):
Sub OLK_Mail(Destinataire$, Objet$, Corps$, NomFich$)
     'Envoi du mail par Outlook
     Dim OlkApp As Object, OlkMail As Object
     Set OlkApp = CreateObject("Outlook.Application")
     Set OlkMail = OlkApp.CreateItem(0)
    
     On Error Resume Next
     With OlkMail
          .To = Destinataire
          .CC = ""
          .BCC = ""
          .Subject = Objet
          .Body = Corps
          .Attachments.Add NomFich
          .Send
     End With
     On Error GoTo 0
    
     OlkApp.Quit
     Set OlkMail = Nothing
     Set OlkApp = Nothing
End Sub

La macro d'envoi via CDO
Code:
Sub CDO_Mail(Expéditeur$, ServeurSMTP$, Motdepasse$, Destinataire$, Objet$, Corps$, NomFich$)
     'Envoi du mail par CDO
     Dim iMsg As Object, iConf As Object, Flds As Variant
    
     Set iMsg = CreateObject("CDO.Message")
     Set iConf = CreateObject("CDO.Configuration")
    
     iConf.Load -1     'Config par défaut
     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") = Expéditeur
          .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Motdepasse
          .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = ServeurSMTP
          
          .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
          .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
          .Update
     End With

     With iMsg
          Set .Configuration = iConf
          .To = Destinataire
          .CC = ""
          .BCC = ""
          .From = """" & Application.UserName & """ <" & Expéditeur & ">"
          .Subject = "Récapitulatif du " & Format(Now, "dd/mm/yyyy")
          .TextBody = Corps
          .AddAttachment NomFich
          .Send
     End With
    
     Set iMsg = Nothing
     Set iConf = Nothing
     Set Flds = Nothing
End Sub

Une copie d'écran :
1654637924038.png


Vois le fichier joint
Amicalement
Alain
 

Pièces jointes

  • VBA- Créer copie d'une plage de cellule dans nouveau classeur et envoyer par mail.xlsm
    34.4 KB · Affichages: 10

MONTREAL2020

XLDnaute Junior
Re-bonjour,

Je reviens vers vous Alain, le code marche super bien sur Outlook. Toutefois, il le fichier bogue dès le 1er envoi.

J'ai tenté de fermer et le réouvrir afin de m'en assurer que c'est juste un gel, mais néanmoins cela persiste.

Merci infiniment
 

MONTREAL2020

XLDnaute Junior
Bonjour Alain,
Merci pour ton assistance, j'apprécie énormément.
Tu trouveras en PJ le fichier, mais aussi à ma surprise ce matin quand je roule al macro, ma session outlook se ferme !!!.

Je te souhaite une excellente journée
 

Pièces jointes

  • VBA- Créer copie d'une plage de cellule dans nouveau classeur et envoyer par mail (2).xlsm
    32.9 KB · Affichages: 5

AtTheOne

XLDnaute Impliqué
Supporter XLD
Bonjour @MONTREAL2020
ma session outlook se ferme !!!.
Bon ça c'est facile, ça vient de l'instruction "OlkApp.Quit" que j'ai mise dans la Sub OLK_Mail(Destinataire$, Objet$, Corps$, NomFich$) :
Enrichi (BBcode):
    .....
     On Error GoTo 0
  
     OlkApp.Quit   'A supprimer ou mettre en commentaire
     Set OlkMail = Nothing
     Set OlkApp = Nothing
End Sub
/CODE]
tu peux la supprimer

Pour le reste, la version que j'ai reçue fonctionne chez moi (avec l'adresse que j'utilise et Outlook, avec deux adresses et CDO) difficile de t'aider dans ce cas.
Mais on peut essayer pas à pas d'abord d'exécuter un Msgbox au lieu d'envoyer un mail pour discerner la partie du code qui pose problème. je te propose de mettre en commentaire une partie du code et de la remplacer par des msgbox :
Enrichi (BBcode):
     ....
     'Envoi du mail choix Outlook, CDO
     Select Case Service
     Case "Outlook"
'         OLK_Mail Destinataire, Objet, Corps, NomFich
         Msgbox "Vous avez choisi Outlook ..."
     Case "CDO"
'         CDO_Mail Expéditeur, ServeurSMTP, Motdepasse, Destinataire, Objet, Corps, NomFich
         Msgbox "Vous avez choisi CDO..."
     End Select
     ....

Si tu peux simuler tes envois sans problème, c'est que le problème viens d'un des sub OLK_Mail ou CDO_Mail ...

Bon courage
Amicalement
Alain
 
Dernière édition:

MONTREAL2020

XLDnaute Junior
Bonjour @MONTREAL2020

Bon ça c'est facile, ça vient de l'instruction "OlkApp.Quit" que j'ai mise dans la Sub OLK_Mail(Destinataire$, Objet$, Corps$, NomFich$) :
Enrichi (BBcode):
    .....
     On Error GoTo 0
 
     OlkApp.Quit   'A supprimer ou mettre en commentaire
     Set OlkMail = Nothing
     Set OlkApp = Nothing
End Sub
/CODE]
tu peux la supprimer

Pour le reste, la version que j'ai reçue fonctionne chez moi (avec l'adresse que j'utilise et Outlook, avec deux adresses et CDO) difficile de t'aider dans ce cas.
Mais on peut essayer pas à pas d'abord d'exécuter un Msgbox au lieu d'envoyer un mail pour discerner la partie du code qui pose problème. je te propose de mettre en commentaire une partie du code et de la remplacer par des msgbox :
Enrichi (BBcode):
     ....
     'Envoi du mail choix Outlook, CDO
     Select Case Service
     Case "Outlook"
'         OLK_Mail Destinataire, Objet, Corps, NomFich
         Msgbox "Vous avez choisi Outlook ..."
     Case "CDO"
'         CDO_Mail Expéditeur, ServeurSMTP, Motdepasse, Destinataire, Objet, Corps, NomFich
         Msgbox "Vous avez choisi CDO..."
     End Select
     ....

Si tu peux simuler tes envois sans problème, c'est que le problème viens d'un des sub OLK_Mail ou CDO_Mail ...

Bon courage
Amicalement
Alain
Bonjour @MONTREAL2020

Bon ça c'est facile, ça vient de l'instruction "OlkApp.Quit" que j'ai mise dans la Sub OLK_Mail(Destinataire$, Objet$, Corps$, NomFich$) :
Enrichi (BBcode):
    .....
     On Error GoTo 0
 
     OlkApp.Quit   'A supprimer ou mettre en commentaire
     Set OlkMail = Nothing
     Set OlkApp = Nothing
End Sub
/CODE]
tu peux la supprimer

Pour le reste, la version que j'ai reçue fonctionne chez moi (avec l'adresse que j'utilise et Outlook, avec deux adresses et CDO) difficile de t'aider dans ce cas.
Mais on peut essayer pas à pas d'abord d'exécuter un Msgbox au lieu d'envoyer un mail pour discerner la partie du code qui pose problème. je te propose de mettre en commentaire une partie du code et de la remplacer par des msgbox :
Enrichi (BBcode):
     ....
     'Envoi du mail choix Outlook, CDO
     Select Case Service
     Case "Outlook"
'         OLK_Mail Destinataire, Objet, Corps, NomFich
         Msgbox "Vous avez choisi Outlook ..."
     Case "CDO"
'         CDO_Mail Expéditeur, ServeurSMTP, Motdepasse, Destinataire, Objet, Corps, NomFich
         Msgbox "Vous avez choisi CDO..."
     End Select
     ....

Si tu peux simuler tes envois sans problème, c'est que le problème viens d'un des sub OLK_Mail ou CDO_Mail ...

Bon courage
Amicalement
Alain
Bonjour Alain,

Désolé d'avoir pris du temps pour te répondre.
Ca marche comme sur des roulettes 😊

Merci encore une fois pour ton aide et ta disponibilité.
 

Discussions similaires

Statistiques des forums

Discussions
311 716
Messages
2 081 828
Membres
101 823
dernier inscrit
mohamed3s