Bonjour,

J'ai le code ci-dessous qui permet, suite à un rappel sur Outlook de lancer un teste dans un fichier exel et de rédiger des e-mail de rappel.
Le code marche bien de façon global, mise à part que ce n'est pas systématique.
En général si je le lance une deuxième fois de suite:
Erreur 1004 "La méthode Rows de l'objet Global à échoué
ou
Erreur 1004 "Impossible de lire la propriété Open de la classe Workbooks"
ou
Erreur 462 "Le serveur distant n'existe pas ou n'est pas disponible"

Tout ça de façon aléatoire ou en tout cas je ne trouve pas la cause. Par contre j'ai remarque que dans le gestionnaire des taches, Excel n'est pas refermé alors qu'il est censé être fermé.

J'ai tenté
Code : Sélectionner tout - Visualiser dans une fenêtre à part
Set XlClas = XlApp.Workbooks.Open(Chemin, UpdateLinks = False, , , "codesecret")
mais du coup il me demande le mot de passe...

Avez-vous une idée?

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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
'Private Sub Application_Reminder(ByVal Item As Object)
Sub test()
  Dim XlApp As Object
    Dim XlClas As Object
    Dim Fe As Object
    Dim Chemin As String
  '  Dim i As Integer
    Dim J As Integer
    Dim Message As String
    Dim RefFourn As String
    Dim OutMail As Outlook.MailItem
    Dim TDate As Date
 
    Dim Ligne1, Ligne2, Ligne3 As String
    Dim Doc1, Doc2, Doc3, Doc4, Doc5 As String
 
    Dim DernLigne As Long
    Dim introMessage As String
    Dim Dico, T, i As Long
 
 
 
    Chemin = "L:\Suivi des MP WS.xlsm"
 
 
    'partie concernant Excel :
    '________________________________________________________________________
    Set XlApp = CreateObject("Excel.Application")
    Set XlClas = XlApp.Workbooks.Open(Chemin, , , , "code")
    Set Fe = XlClas.Worksheets("Rapport suivi délais") 'la feuille où se trouvent les dates
    Set Dico = CreateObject("Scripting.Dictionary")
    T = Fe.Range("A2:I" & Fe.Range("A" & Rows.Count).End(xlUp).Row)
 
'** initialisation du dico par code fournisseur unique
For i = LBound(T, 1) To UBound(T, 1)
    Dico(T(i, 1)) = ""
Next
 
 
 
 
For Each Fourn In Dico.keys ' pour chaque fournisseur
    For i = LBound(T, 1) To UBound(T, 1) 'on balaye les lignes du tableau
 
 
' code traitement des matières
 
        If T(i, 1) = Fourn Then ' si le code fournisseur du tableau = celui qu'on veut traiter
 
   Destinataire = T(i, 1) & " - " & T(i, 2)
 
 
  If T(i, 5) <> "" Then              'Teste date 1 en E
    Doc1 = " le cahier des charges,"
    Else: Doc1 = ""
  End If
 
 
  If T(i, 6) <> "" Then              'Teste date 2 en F
    Doc2 = " la fiche technique,"
    Else: Doc2 = ""
 End If
 
 If T(i, 7) <> "" Then           'Teste date 3 en G
    Doc3 = " l'attestation de no,"
    Else: Doc3 = ""
 End If
 
 If T(i, 8) <> "" Then   'Teste date 4 en H
    Doc4 = " l'attestation de non i,"
    Else: Doc4 = ""
 End If
 
 
 If T(i, 9) <> "" Then   'Teste date 5 en I
    Doc5 = " la fiche de données de séc,"
    Else: Doc5 = ""
 End If
 
 
        If Doc1 <> "" Or Doc2 <> "" Or Doc3 <> "" Or Doc4 <> "" Or Doc5 <> "" Then
       Ligne1 = "Pour la matière: " & T(i, 3) & " " & T(i, 4) & ":" _
        & Doc1 & Doc2 & Doc3 & Doc4 & Doc5
        End If
 
            Message = Chr(13) & Message & Chr(13) & Chr(13) & Ligne1
 
 
 
        End If
 
 
 
   Next i 'Matiere suivante
 
    '_____________________Préparation d'un e-mail pour chaque fournisseur en synthétisant toutes les demandes___________________________________________________
 
introMessage = "Bonjour," & Chr(13) & Chr(13) & "D'après notre base de données documentaire, les documents suivants arrivent à péremption."
 
 
             Textemail = "Pour " & Destinataire & Chr(13) & Chr(13) _
             & introMessage & Chr(13) _
            & Message _
            & Chr(13) & Chr(13) & "Merci de bien vouloir nous envoyer une version récente pour chacun d'eux." _
            & Chr(13) & Chr(13) _
            & "Cordialement," & Chr(13) & "LaMereMICHEL"
 
 
 
 
      Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    'corps du message si besoin
 
    With OutMail
        .To = "Test@essai.fr"        'destinataire(s)
        '.CC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com"          ' copie
        '.BCC = "aaaaa@gmail.com,bbbbbb@gmail.com,ccccccc@gmail.com"       ' si BCC
        .Subject = "Demande de documents à jour"
        .Body = Textemail
        'Piece_jointe
        '.Attachments.Add ("C:\test.txt")        'mettre chemin et fichier a joindre
        .Display        'ouvre Outlook
        'or use
        '.Send           'envoi sans ouvrir Outlook
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
 
 
Message = ""
 
 
 
Next  'Fournisseur suivant
'Wend
 
    XlClas.Close True    'on ferme le classeur
    XlApp.Quit    'On quitte Excel
 
End Sub