Besoin de conseil pour modier ce code

Bricoltou · 27 Janvier 2010

Bonsoir le Forum

En ayant fait des recherches j'ai trouvé et modifié ce code pour envoyer une feuille de classeur par mail via outloock.
je voudrais pouvoir envoyer deux feuilles de classeurs au même destinataires ,voir a plusieurs destinataires .
J'ai essayé plusieurs modification ( ajouter une ligne pour le 2 onglets )ou séparé les adresses mails par des points virgules .
Mais rien ne marche 😱
Pouvez vous m'aider

Merci d'avance

Bricoltou

Code:

Sub Mail()
Dim adresse As String, sujet As String, body As String
Dim MailAd As String, Msg As Variant, Subj As String, URLto As String
Dim répertoireappli As String
Dim fich As String
      Workbooks.Open Filename:= _
                           "K:\Pilotage\Camionnage\Controle_Camion.xls"
                          ActiveSheet.Unprotect Password:="Terminal"
répertoireappli = ActiveWorkbook.Path
'copie la feuille a envoyer
Sheets("Semaine").Copy
'crée le fichier
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireappli & "\Suivi_Contrôle_Camion.xls"
MailAd = "alfred.bricoltou@XXX.com" 'A ADAPTER
Msg = "Contrôle Véhicule   "
'Msg = Msg & "Consommation Gas_oil"
ActiveWorkbook.SendMail MailAd, Msg
ActiveSheet.Protect Password:="Terminal"
ActiveWindow.Close
End Sub

Hulk · 27 Janvier 2010

Re : Besoin de conseil pour modier ce code

Bonjour,

Actives, dans l'éditeur de macro en cliquant sur Outils/Références, la référence :

Microsoft Outlook 11.0 Object Library.

Puis testes avec ce code

Code:

Sub Mail()

    Dim Ol As New Outlook.Application
    Dim Olmail As MailItem
    Dim CurrFile As String
    Dim répertoireappli As String

    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    
    Workbooks.Open Filename:="K:\Pilotage\Camionnage\Controle_Camion.xls"
    ActiveSheet.Unprotect Password:="Terminal"
    répertoireappli = ActiveWorkbook.Path
    'copie les feuilles à envoyer
    Sheets(Array("Semaine 1", "Semaine 2")).Copy 'Avec le Array pour sélectionner plusieurs feuilles
    'crée le fichier
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireappli & "\Suivi_Contrôle_Camion.xls"
    PathName = répertoireappli & "\Suivi_Contrôle_Camion.xls"
    
    With Olmail
        .To = "tata1@cheztata1.com"
        .CC = "tata2@cheztata2.com"
        .Subject = "Contrôle véhicule"
        .body = "Rapport véhicule"
        .Attachments.Add PathName
        .Send 'Ou Display voir le message avant de l'envoyer
    End With
    
    ActiveSheet.Protect Password:="Terminal"
    ActiveWindow.Close

End Sub

Attention aux noms des feuilles, pour tester je les ai nommées "Semaine 1" et "Semaine 2", à toi d'adapter... ainsi que les adresses.

EDIT : Tu peux, sauf erreur, pour plusieurs destinataires aussi écrire ainsi :

Code:

.To = "tata1@cheztata1.com;tata2@cheztata2.com"

'Ou/Et

.CC = "tata3@cheztata3.com;tata4@cheztata4.com;etc..."

Bricoltou · 28 Janvier 2010

Re : Besoin de conseil pour modier ce code

Bonjour Le Forum,Hulk

Merci pour ta réponse , j'essaie et reviens vers vous

Merci pour votre aide 😎

Bricoltou

Bricoltou · 1 Février 2010

Re : Besoin de conseil pour modier ce code

Bonjour le Forum, Hulk

Aprés modification le code fonctionne , mais est il possible de supprimer le fichier qu'il vient de creer aprés l'envoi du Mail car j'ai un envoi par semaine et je n'ai pas besoin de sauvegarde

Merci d'avance pour votre aide

Bricoltou

Code:

Sub MailManquant()
   Dim Ol As New Outlook.Application
    Dim Olmail As MailItem
    Dim CurrFile As String
    Dim répertoireappli As String

    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    Workbooks.Open Filename:="K:\Pilotage\Camionnage\Manquant.xls"
    ActiveSheet.Unprotect Password:="Xavier"
    répertoireappli = ActiveWorkbook.Path
    'copie les feuilles à envoyer
    Sheets("Synthese").Copy 'Avec le Array pour sélectionner plusieurs feuilles
    'crée le fichier
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireappli & "\Manquant du Mois.xls"
    PathName = répertoireappli & "\Manquant.xls"
    
    With Olmail
        .To = "xxxxxxxx.com;xxxxx.com;xxxxxx.com;xxxxx.com"
        .CC = "xxxxx.com"
        .Subject = "Fichier des Manquants"
        .body = "Merci de faire des recherches"
        .Attachments.Add PathName
        .Send 'Ou Display voir le message avant de l'envoyer
    End With
    
    ActiveSheet.Protect Password:="Xavier"
    ActiveWindow.Close
   

End Sub

Bricoltou · 2 Février 2010

Re : Besoin de conseil pour modier ce code

Bonsoir le Forum

Quelqu'un a t-il une idée pour me venir en aide SVP 😕

Merci d'avance 😎

Bricoltou

Bricoltou à dit:

Bonjour le Forum, Hulk

Aprés modification le code fonctionne , mais est il possible de supprimer le fichier qu'il vient de creer aprés l'envoi du Mail car j'ai un envoi par semaine et je n'ai pas besoin de sauvegarde

Merci d'avance pour votre aide

Bricoltou

Code:

Sub MailManquant()
   Dim Ol As New Outlook.Application
    Dim Olmail As MailItem
    Dim CurrFile As String
    Dim répertoireappli As String

    Set Ol = New Outlook.Application
    Set Olmail = Ol.CreateItem(olMailItem)
    Workbooks.Open Filename:="K:\Pilotage\Camionnage\Manquant.xls"
    ActiveSheet.Unprotect Password:="Xavier"
    répertoireappli = ActiveWorkbook.Path
    'copie les feuilles à envoyer
    Sheets("Synthese").Copy 'Avec le Array pour sélectionner plusieurs feuilles
    'crée le fichier
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs répertoireappli & "\Manquant du Mois.xls"
    PathName = répertoireappli & "\Manquant.xls"
    
    With Olmail
        .To = "xxxxxxxx.com;xxxxx.com;xxxxxx.com;xxxxx.com"
        .CC = "xxxxx.com"
        .Subject = "Fichier des Manquants"
        .body = "Merci de faire des recherches"
        .Attachments.Add PathName
        .Send 'Ou Display voir le message avant de l'envoyer
    End With
    
    ActiveSheet.Protect Password:="Xavier"
    ActiveWindow.Close
   

End Sub

Hulk · 2 Février 2010

Re : Besoin de conseil pour modier ce code

Hello,

Essaie ceci en fin de macro, avant le Protect -> Kill "C:\blabla\blabla.xls" 'Chemin à adapter

Ou, mais je doute -> Kill PathName

Ou encore -> Kill répertoireappli & "\Manquant.xls" mais je doute aussi.

Bricoltou · 2 Février 2010

Re : Besoin de conseil pour modier ce code

Bonsoir le Forum, Hulk

Merci encore pour ton aide , le code bloque avec le message suivant
Erreur d'execution 70 Permission refusé
J'ai essayé de positionner le code aprés la protection mais idem

Code:

With Olmail
        .To = "xxxxxxx.com"
        '.CC = "xxxxxx.com"
        .Subject = "Contrôle Carburant"
        .body = "Suvi Consomation"
        .Attachments.Add PathName
        .Send    'Ou Display voir le message avant de l'envoyer
    End With
    [COLOR="Red"][B]Kill "K:\Pilotage\Camionnage\Suivi_Contrôle_Carburant.xls" 'Chemin à adapter"[/B][/COLOR]    ActiveSheet.Protect Password:="Carburant"
    ActiveSheet.Protect Password:="Carburant"
  ActiveWindow.Close

Bricoltou · 3 Février 2010

Re : Besoin de conseil pour modier ce code

Bonsoir le Forum

quelqu'un a déjà eu cette erreur d'éxécution .

Merci d'avance pour votre aide

Bricoltou

Bricoltou à dit:
Bonsoir le Forum, Hulk

Merci encore pour ton aide , le code bloque avec le message suivant
Erreur d'execution 70 Permission refusé
J'ai essayé de positionner le code aprés la protection mais idem

Code:

With Olmail .To = "xxxxxxx.com" '.CC = "xxxxxx.com" .Subject = "Contrôle Carburant" .body = "Suvi Consomation" .Attachments.Add PathName .Send 'Ou Display voir le message avant de l'envoyer End With [COLOR="Red"][B]Kill "K:\Pilotage\Camionnage\Suivi_Contrôle_Carburant.xls" 'Chemin à adapter"[/B][/COLOR] ActiveSheet.Protect Password:="Carburant" ActiveSheet.Protect Password:="Carburant" ActiveWindow.Close

Besoin de conseil pour modier ce code

Bricoltou

XLDnaute Occasionnel

Hulk

XLDnaute Barbatruc

Bricoltou

XLDnaute Occasionnel

Bricoltou

XLDnaute Occasionnel

Bricoltou

XLDnaute Occasionnel

Hulk

XLDnaute Barbatruc

Bricoltou

XLDnaute Occasionnel

Bricoltou

XLDnaute Occasionnel

Discussions similaires

Besoin de conseil pour modier ce code

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency