Temporisation de l'envoi d'un mail automatique

gilles52300 Messages postés 34 Date d'inscription Statut Membre Dernière intervention -
gilles52300 Messages postés 34 Date d'inscription Statut Membre Dernière intervention - 20 janv. 2017 à 09:24

Bonjour la communauté,

Me voici devant un léger souci....
J'ai une liste client a qui j'envoie un mail avec une pièce jointe.

Ma macro fonctionne très bien et tout se passe normalement si je n'envoie pas mon mail automatiquement... ou cela se complique c'est si je fais l'envoie automatique, la pièce jointe n'a pas le temps d'être inséré que le mail est déjà parti. (Avouer c'est très Balot!)

Je cherche a temporiser l'envoi du mail de manière à laisser le temps à la pièce jointe d'arriver.

je pense savoir ou mettre la temporisation :

    If displaymail = False Then scriptToRun = scriptToRun & "send" & Chr(13)
    scriptToRun = scriptToRun & "end tell" & Chr(13)
    scriptToRun = scriptToRun & "end tell"

Mais le truc c'est quoi mettre et comment.

Si l'un de vous a une idée de Génie, alors je suis preneur... merci de votre aide.

je veux joindre mon fichier, mais je ne sais pas comment.... :)

Afficher la suite

A voir également:

Macro outlook envoi mail automatique
Réponse automatique thunderbird - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
Programmer envoi mail gmail - Guide
Supprimer adresse mail outlook - Guide
Envoi mail cci - Guide

1 réponse

Réponse 1 / 1

gilles52300 Messages postés 34 Date d'inscription Statut Membre Dernière intervention

Je vous joint les codes

Module 1

Option Explicit

Private Sub Ellipse1_QuandClic()

Dim CorpsDeMail$, Sujet$, Photo$, Client$, NomClient$
Dim c As Byte
Dim wb As Workbook
'Dim Delai As Date

'enregistrement du chemin de la photo
        Photo = Application.PathSeparator & "Users" & Application.PathSeparator & "Gilles" _
                    & Application.PathSeparator & "Documents" & Application.PathSeparator & "Travail" _
                    & Application.PathSeparator & "geo-tp" & Application.PathSeparator & "Pub" _
                    & Application.PathSeparator & "Voeux" & Application.PathSeparator & "2017.gif"
'prendre les clients de la liste un par un en descendant
        c = 1
'boucle des Emails tant que la cellule n'est pas vide.
1:
        c = c + 1
        Client = Sheets("Liste client").Range("I" & c)
        If Client = "" Then GoTo 2
'préparation du corps de mail
        NomClient = Sheets("Liste client").Range("K" & c) & " " & Sheets("Liste client").Range("L" & c) & ","
        With Sheets("Mailing")
            Sujet = .Range("B9")
            CorpsDeMail = .Range("B10") & " " & NomClient & Chr(10) _
                        & Chr(10) _
                        & .Range("B11") & Chr(10) _
                        & .Range("B12") & Chr(10) _
                        & .Range("B13") & Chr(10) _
                        & Chr(10) _
                        & .Range("A2") & Chr(10) _
                        & .Range("A6") & Chr(10) _
                        & .Range("A7") & Chr(10) _
                        & "Tel : " & .Range("A5") & Chr(10) _
                        & Chr(10)
        End With
        'MsgBox CorpsDeMail
'Email
        Set wb = ActiveWorkbook
            With wb
                MailFromMacWithMail attachment:=Photo, _
                            mailsubject:=Sujet, _
                            toaddress:=Client, _
                            ccaddress:="", _
                            bccaddress:="", _
                            bodycontent:=CorpsDeMail, _
                            displaymail:=False
            End With
        Set wb = Nothing
        'Forcer l'application à attendre 4 seconde avant l'envoi du mail.
        'Application.Wait Now + TimeValue("0:00:04")
    GoTo 1
2:
End Sub

Module 2

Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
           toaddress As String, ccaddress As String, bccaddress As String, _
                attachment As String, displaymail As Boolean)



    Dim scriptToRun As String

    scriptToRun = scriptToRun & "tell application " & _
                  Chr(34) & "Mail" & Chr(34) & Chr(13)

    scriptToRun = scriptToRun & _
         "set NewMail to make new outgoing message with properties " & _
            "{content:""" & bodycontent & """, subject:""" & _
               mailsubject & """ , visible:true}" & Chr(13)

    scriptToRun = scriptToRun & "tell NewMail" & Chr(13)

    If toaddress <> "" Then scriptToRun = scriptToRun & _
       "make new to recipient at end of to recipients with properties " & _
       "{address:""" & toaddress & """}" & Chr(13)

    If ccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new cc recipient at end of cc recipients with properties " & _
       "{address:""" & ccaddress & """}" & Chr(13)

    If bccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new bcc recipient at end of bcc recipients with properties " & _
       "{address:""" & bccaddress & """}" & Chr(13)

    If attachment <> "" Then
        scriptToRun = scriptToRun & "tell content" & Chr(13)
        scriptToRun = scriptToRun & "make new attachment with properties " & _
                      "{file name:""" & attachment & """ as alias} " & _
                      "at after the last paragraph" & Chr(13)
        scriptToRun = scriptToRun & "end tell" & Chr(13)
    End If

    If displaymail = False Then scriptToRun = scriptToRun & "send" & Chr(13)
    scriptToRun = scriptToRun & "end tell" & Chr(13)
    scriptToRun = scriptToRun & "end tell"

    If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
        MsgBox "There is no To, CC or BCC address or Subject for this mail"
        Exit Function
    Else
        On Error Resume Next

   'MsgBox scriptToRun

        MacScript (scriptToRun)

        On Error GoTo 0
    End If
End Function

Discussions similaires

Rétrodiffusion "Mail Delivery System"

Echec d'envoi message sur Messenger

Votre réponse

Discussions similaires