Discussion :

[nonesofar]

Bonjour,

J'ai développé une macro qui permet de télécharger la PJ d'un email dans un dossier sur le lecteur C de l'utilisateur.

La macro fonctionne parfaitement sauf que lorsqu'un utilisateur est sous 2010, il faut activer Microsoft Outlook 14.0 Object Library

Or sous 2013 il faut activer Microsoft Outlook 15.0 Object Library comme sur la capture d'écran ci-dessous.


Cela fait bugger à chaque fois le code entre les deux utilisateurs, ce qui pénible !!

J'ai essayé de bindé mon code sans succés .

Si vous avez une piste sur ce sujet?

Merci d'avance !!

Le code :

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
    Dim olApp As Object
    Dim olSpace As Object
    Dim olInbox As Object
    Dim olFolder As Object
    Dim olMail As Object
    Dim pceJointe As Object
    Dim PJ As Boolean
 
 
Dim NomDossier As String
Dim i As Integer
Dim strPath As String, PathOrigine As String
Dim NomOrigine As String
Dim reponse As Variant
 
'test si outlook ouvert
    Set olApp = CreateObject("Outlook.Application")
 
 If olApp.ActiveWindow Is Nothing Then
        Sheets("Start").Activate
        Title = "Error"
        reponse = MsgBox("Thanks to open Microsoft Outlook before updating database", vbCritical + vbOKOnly, Title)
        Exit Sub
    End If
 
Compare = False
PJ = False
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
'Défini le dossier OutLook recherché
NomDossier = "LCR Wemed"
 
    Set olSpace = olApp.GetNamespace("MAPI")
    Set olInbox = olSpace.GetDefaultFolder(olFolderInbox)
    Set olFolder = olInbox.Folders(NomDossier)
    Set olMail = olApp.CreateItem(olMailItem)
    Set pceJointe = olMail.Attachments
 
'Check si dossier tampon existe sur le pc et va le créer sinon
If Len(Dir("C:\Tampon\", vbDirectory)) = 0 Then
   MkDir "C:\Tampon\"
End If
 
PathOrigine = "C:\Tampon\"
Bascule = False
 
For Each olMail In olFolder.Items
 
   If Day(olMail.SentOn) = Day(Now) And Abs(DateDiff("h", olMail.ReceivedTime, Now())) <= 24 And olMail.SentOn > lastin Then
       If olMail.Attachments.Count > 0 Then
 
           For y = 1 To olMail.Attachments.Count
               Set pceJointe = olMail.Attachments(y)
 
               If InStr(1, pceJointe.Filename, "LCR16-Voyage All Legs") Then
 
                    NomOrigine = y & "_" & pceJointe
                    pceJointe.SaveAsFile PathOrigine & NomOrigine
                    lastin = olMail.SentOn
 
                    Bascule = True
               End If
 
               Set pceJointe = Nothing
           Next y
 
        End If
    End If
 
Next olMail