IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

EmailMsg : ne pas enregistrer les mails envoyés [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Candidat au Club
    Homme Profil pro
    Conseil en assistance à maîtrise d'ouvrage
    Inscrit en
    février 2013
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Conseil en assistance à maîtrise d'ouvrage

    Informations forums :
    Inscription : février 2013
    Messages : 6
    Points : 4
    Points
    4
    Par défaut EmailMsg : ne pas enregistrer les mails envoyés
    Bonjour,

    Je suis nouveau sur le forum. Tout d'abord un grand merci à vous pour le service que vous rendez, ce site et votre contribution m'ont souvent permis de me débloquer dans mes projets.

    Je travaille actuellement sur un outil de mailing qui génère des emails en grande quantité.
    Je souhaiterais savoir comment indiquer dans ma macro par une instruction de ne pas enregistrer les mails envoyés (pour ne pas obstruer la boite mail).
    Si en plus vous savez comment venir lire la checkbox dans Outlook qui dit si le mail va être enregistré ou non (Outils->Options->Préférences->Options de la messagerie->Enregistrer une copie des éléments envoyés) ce serait super !

    Merci à vous,

  2. #2
    Membre émérite
    Homme Profil pro
    Chef de projet en SSII
    Inscrit en
    novembre 2011
    Messages
    1 503
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Irlande

    Informations professionnelles :
    Activité : Chef de projet en SSII

    Informations forums :
    Inscription : novembre 2011
    Messages : 1 503
    Points : 2 657
    Points
    2 657
    Par défaut
    Je ne suis pas sûr...

    Tente ceci lorsque tu fermes chaque mail envoyé:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    Dim myItem As Outlook.MailItem
    '...
    myItem.Close olDiscard
    La logique :
    • Plus ya de gruyère, moins ya de gruyère.
    • Plus tu pédales moins vite, moins tu avances plus vite.
    Plusoyer les réponses pertinentes et n'oublier pas de résolver en fin de post !

  3. #3
    Candidat au Club
    Homme Profil pro
    Conseil en assistance à maîtrise d'ouvrage
    Inscrit en
    février 2013
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Conseil en assistance à maîtrise d'ouvrage

    Informations forums :
    Inscription : février 2013
    Messages : 6
    Points : 4
    Points
    4
    Par défaut
    Merci pour ton aide Kimy_Ire mais cela ne fonctionne pas... Il envoie quand même le mail et l'enregistre. D'autres idées ?

  4. #4
    Membre émérite
    Homme Profil pro
    Chef de projet en SSII
    Inscrit en
    novembre 2011
    Messages
    1 503
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Irlande

    Informations professionnelles :
    Activité : Chef de projet en SSII

    Informations forums :
    Inscription : novembre 2011
    Messages : 1 503
    Points : 2 657
    Points
    2 657
    Par défaut
    D'après ce que j'ai trouvé sur le web, tu ne peux pas clairement supprimer les mails envoyés dans ta boite d'envoie. Mes investigations sont à poursuivre.

    CEPENDANT...

    Il existe un workaround qui consiste à sauvegarder les mails envoyés dans un fichier et de le supprimer.

    Voici le code que j'ai trouvé à ce sujet :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    Sub Mail_ActiveSheet() 
         'Working in 2000-2010
        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 sheet 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 2000-2003
                FileExtStr = ".xls": FileFormatNum = -4143 
            Else 
                 'You use Excel 2007-2010, we exit the sub when your answer is
                 'NO in the security dialog that you only see  when you copy
                 'an sheet from a xlsm file with macro's disabled.
                If Sourcewb.Name = .Name Then 
                    With Application 
                        .ScreenUpdating = True 
                        .EnableEvents = True 
                    End With 
                    MsgBox "Your answer is NO in the security dialog" 
                    Exit Sub 
                Else 
                    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 If 
        End With 
         '    'Change all cells in the worksheet to values if you want
         '    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 = "<a href="mailto:test@yahoo.com">test@yahoo.com</a>" 
                .CC = "" 
                .BCC = "" 
                .Subject = Sheets("MainMenu").Range("G8").Value & " Operations Scorecard opened " & Format(Date, "mm/dd/yy") & " by " & Sheets("MainMenu").Range("A1").Value 
                .Body = "" 
                .Attachments.Add Destwb.FullName 
                .DeleteAfterSubmit = True 'This would let Outlook send the note without storing it in your sent bin
                 '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
    Tout n'est pas à prendre, surtout pour toi, mais cela pourra peut-être t'aider à résoudre ton problème.

    Tiens moi au courant !
    La logique :
    • Plus ya de gruyère, moins ya de gruyère.
    • Plus tu pédales moins vite, moins tu avances plus vite.
    Plusoyer les réponses pertinentes et n'oublier pas de résolver en fin de post !

  5. #5
    Candidat au Club
    Homme Profil pro
    Conseil en assistance à maîtrise d'ouvrage
    Inscrit en
    février 2013
    Messages
    6
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Loire Atlantique (Pays de la Loire)

    Informations professionnelles :
    Activité : Conseil en assistance à maîtrise d'ouvrage

    Informations forums :
    Inscription : février 2013
    Messages : 6
    Points : 4
    Points
    4
    Par défaut
    Citation Envoyé par Kimy_Ire Voir le message
    With OutMail
    .DeleteAfterSubmit = True 'This would let Outlook send the note without storing it in your sent bin
    Parfait !!!
    J'ai trouvé ce que je cherchais dans le code que tu m'as passé Kimy_Ire, c'est ce qui apparait au-dessus. Ça me permet d'envoyer le mail sans l'enregistrer.
    Merci beaucoup pour le temps que tu as passé.

    A bientôt

    Victor

  6. #6
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    4 085
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 4 085
    Points : 7 166
    Points
    7 166
    Billets dans le blog
    20
    Par défaut
    Bonjour,
    Avec Outlook il faut effectivement utiliser
    .DeleteAfterSubmit = True

    mais le mieux c'est d'utiliser CDO il faut par contre un serveur smtp accessible.

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
     
    '---------------------------------------------------------------------------------------
    ' Procedure : SendMailCDO
    ' Author    : Oliv'
    ' Date      : 24/04/2008
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
    Function SendMailCDO(Sender As String, Receiver As String, _
                         subject As String, BodyText As String, _
                         Optional BodyHTML As String, _
                         Optional Cc As String, _
                         Optional Bcc As String, _
                         Optional pvarAttachFile As Variant)
    ' Microsoft CDO for Windows 2000 Library
        Dim Cdo_Message As New CDO.Message
     
        Set Cdo_Message.Configuration = GetSMTPServerConfig()
     
        With Cdo_Message
            .To = Receiver
            .From = Sender
            .subject = subject
            .Cc = Cc
            .Bcc = Bcc
            '.DSNOptions = 2 ' Delivery Status Notification
     
            'pour indiquer le Corps du Mail en brut.
            .TextBody = BodyText
     
            'Décommenter pour indiquer le Corps du Mail en HTML.
            '.HTMLBody = BodyHTML
     
            'Pour envoyer une page WEB en tant que corps du Mail.
            '.CreateMHTMLBody _
             "http://groups.google.com/group/microsoft.public.fr.outlook", _
             CDO.CdoMHTMLFlags.cdoSuppressNone , "", ""
     
            'ou se trouvant sur son pc
            '.CreateMHTMLBody "file:\\C:\INFORMAT\exemples\événements.htm"
     
            ' Ajout de la pièce jointe, 1 ou plusieurs fichiers
            If Not IsMissing(pvarAttachFile) Then
                If IsArray(pvarAttachFile) Then
                    ' parcourrir le tableau
                    For i = LBound(pvarAttachFile) To UBound(pvarAttachFile)
                        objEmail.AddAttachment pvarAttachFile(i)
                    Next i
                Else
                    objEmail.AddAttachment pFileAttach
                End If
            End If
     
    '        If Attach1 <> "" Then
    '            If Len(Dir(Attach1)) > 0 Then
    '                .AddAttachment (Attach1)
    '            Else: MsgBox Attach1 & vbCr & "Ce fichier sera ignoré", _
    '                       , "Fichier à Attacher introuvable !"
    '            End If
    '        End If
     
            'Cette commande envoi le Mail
            On Error Resume Next
            DoEvents
            .Send
            If Err <> 0 Then
    Debug.Print Err.Number & Err.Description & Err.LastDllError
     
                Err.Clear
            End If
        End With
        Set Cdo_Message = Nothing
    End Function
     
     
     
    Function GetSMTPServerConfig() As Object
    ' Microsoft CDO for Windows 2000 Library
     
        Dim Cdo_Config As New CDO.Configuration
        Dim Cdo_Fields As Object
        Set Cdo_Fields = Cdo_Config.Fields
     
        With Cdo_Fields
            .Item(cdoSendUsingMethod) = cdoSendUsingPort
            .Item(cdoSMTPServer) = "smtp.free.fr"
            .Item(cdoSMTPServerPort) = 25
     
            .Item(cdoSMTPConnectionTimeout) = 10    ' quick timeout
            '.Item(cdoSMTPAuthenticate) = cdoBasic
     
            ' IMPORTANT: Storing user names and passwords inside source code
            ' can lead to security vulnerabilities in your software. Do not
            ' store user names and passwords in your production code.
            '.Item(cdoSendUserName) = "username"
            '.Item(cdoSendPassword) = "password"
            '.Item (cdoSMTPUseSSL) = False 'Use SSL for the connection (True or False)
            '.Item(cdoURLProxyServer) = "server:80"
            '.Item(cdoURLProxyBypass) = "<local>"
            '.Item(cdoURLGetLatestVersion) = True
     
            .Update
        End With
     
        Set GetSMTPServerConfig = Cdo_Config
        Set Cdo_Config = Nothing
        Set Cdo_Fields = Nothing
     
    End Function

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. les mails envoyé de mon serveur mail n'arrivent pas à destination
    Par edzodzinam dans le forum Général Conception Web
    Réponses: 3
    Dernier message: 29/08/2008, 19h59
  2. Réponses: 4
    Dernier message: 16/10/2006, 21h20
  3. Réponses: 11
    Dernier message: 16/05/2006, 13h34
  4. [MySQL] Mon livre d'or ne veut pas enregistrer les messages
    Par Invité dans le forum PHP & Base de données
    Réponses: 7
    Dernier message: 15/03/2006, 17h28
  5. [Mail] Comment garder les mails envoyés?
    Par JSuper_Kitten dans le forum Langage
    Réponses: 5
    Dernier message: 16/10/2005, 15h00

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo