Discussion :

[Rch_Dcrt]

Bonjour à tous,

ci-joint deux procédures qui permettent d'enregistrer le dernier mail dans un dossier sur le bureau.
le but serait donc d'enregistrer chaque mail à sa réception dans le dossier.

Mais le problème étant le déclenchement du code : lorsque je le programme à l'arrivé d'un nouveau message, il s’exécute avant d'afficher le nouveau message, enregistrant alors l'avant dernier...
Une des solutions serait de programmer ce code sur minuterie mais je ne sais pas comment faire.

Si vous avez des solutions ou des idées je suis à l'écoute !
Merci d'avance !

Code déclenché sur réception :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Script(MyMail As MailItem)                'ou Private Sub Application_NewMail() marcherait aussi 
 
    Dim MonOutlook As Outlook.Application
    Dim lemail As Object
    Dim LesMails As Outlook.Selection
    Set bdr = Outlook.CreateObject(test)
    Set MonOutlook = Outlook.Application
 
                       'recupère le dernier mail
       sav_mail_as_msg MonOutlook.ActiveExplorer.CurrentFolder.Items(MonOutlook.ActiveExplorer.CurrentFolder.Items.Count)
 
End Sub

Il en appelle à celui ci :

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
Sub sav_mail_as_msg(Optional objCurrentMessage As Object)
'By Oliv' juillet 2007 pour OUTLOOK 2003
 
    If objCurrentMessage Is Nothing Then Set objCurrentMessage = ActiveInspector.CurrentItem
 
    'Ici on construit le nom du fichier qui sera créé
    NomExport = objCurrentMessage.ReceivedTime & " Objet  " & objCurrentMessage.Subject & " De  " & objCurrentMessage.SenderName
    'Ici on défini le répertoire où l'enregistrer
    repertoire = "D:\Users\Richard\Desktop\dossiermail\"
    'repertoire = BrowseForFolder("Choisissez la destination", SDossier(5, 0)) & "\"
 
    'Ici on supprime les caractères non autorisé dans les noms de fichiers
    PathNomExport = repertoire & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160) & ".msg"
 
    'Ici on vérifie que le fichier n'existe pas déjà sinon il serait écrasé
    n = 1
    MemPath = PathNomExport
    While Dir(PathNomExport) <> ""
        'MsgBox "Le fichier " & vbCr & PathNomExport & vbCr & "existe déjà", vbInformation
        Exit Sub
        'PathNomExport = Left(MemPath, Len(MemPath) - 4) & "(" & n & ")" & ".msg"
        'n = n + 1
    Wend
    objCurrentMessage.SaveAs PathNomExport, OlSaveAsType.olMSG
 
End Sub

[QuestVba]

Bonjour,

Tu ne pourrais pas utiliser une règle pour déclencher ton code ?

[Rch_Dcrt]

Bonjour,
Lorsque l'on nomme la procédure avec le fameux "script", cela permet de l'appeler avec une règle,
j'ai d'ailleurs mis les deux possibilités ci-dessus, mais malheureusement, dans les deux cas mon problème reste le même
Merci quand même !