Bonjour,

J'utilisais une macro excel (excel 2003) sous windows XP pour sauvegarder automatiquement les pièces jointes.
Je suis passé à Windows 7 avec Office 2010 et Lotus Notes 8.5.1
Malheuresement le code ne marche plus.

J'avais un premier problème sur la connexion que j'ai résolu en utilisant :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Call session.InitializeUsingNotesUserName(id, motdepasse)
Ensuite j'avais une erreur sur l'ouverture de la database :
erreur d'exécution '-2147217441
Database has not been open yet
J'ai cherché sur internet et sur le forum mais je n'ai rien trouvé qui puisse m'aider.

D'avance merci pour votre aide.

Ci-dessous le code d'origine
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
 
Public Sub ESyco()
 
'Déclaration Variable
Dim fichier As NotesEmbeddedObject
Dim AttachmentName As String
Dim FileName As String
Dim PostedDate As String
Dim DateFile As String
Dim Subject As String
Dim ExtractionFolder As String
 
'Initialisation de la session avec mot de passe
session.Initialize ("mot de passe")
 
'Connexion au serveur
Set catalog = session.GetDbDirectory("PARMAIL121/SERVERS/GROUP")
 
'Connexion au fichier
Set db = catalog.OpenMailDatabase 
 
'Connexion sur la vue de boîte de réception
'Set view = db.GetView("($INBOX)")
Set view = db.GetView("Prod\ES")
 
'Se placer sur le premier document
Set Doc = view.GetFirstDocument
 
ExtractionFolder = "c:\temp"
ChDrive "C"
 
'Tant qu'il y a un document
Do While Not Doc Is Nothing
    'Mail information
    PostedDate = Doc.GetFirstItem("PostedDate").Text
    Subject = Doc.GetFirstItem("Subject").Text
 
    If InStr(1, Subject, "(2)") = 0 Then
 
        ExtractionFolder = "C:\Tests\" & Mid(PostedDate, 7, 4) & Mid(PostedDate, 4, 2) & Left(PostedDate, 2) 'For French date
       ' ExtractionFolder = "C:\Tests\" & Mid(PostedDate, 7, 4) & Left(PostedDate, 2) & Mid(PostedDate, 4, 2)
 
        If Dir(ExtractionFolder, vbDirectory) = "" Then
            MkDir ExtractionFolder
            MkDir ExtractionFolder & "\Prod"
            MkDir ExtractionFolder & "\UAT"
        End If
 
 
        If Left(Subject, 3) = "!!!" Then
            ExtractionFolder = ExtractionFolder & "\Prod"
        Else
            ExtractionFolder = ExtractionFolder & "\UAT"
        End If
 
        'DateFile = Date
 
 
        Dim Item As NotesItem
        Set Item = Doc.GetFirstItem("$FILE")
        Dim ItemName As String
        ItemName = Item.Values(0)
 
 
        Set fichier = Doc.GetAttachment(ItemName)  '(AttachmentName)
        fichier.ExtractFile ExtractionFolder & "\" & ItemName
        ChDir ExtractionFolder
        If rename_esyco_file(ItemName) <> "error" Then Name ItemName As rename_esyco_file(ItemName)
 
    End If
    Doc.Remove True
    'Doc.RemovePermanently True
 
    'on passe au mail suivant
    Set Doc = view.GetFirstDocument
Loop
 
Set session = Nothing
 
End Sub