Erreur 1004 ou 462

**WalTT** · 26/02/2019, 15h16

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

**mercatog** · 26/02/2019, 16h01

Bonjour

Ferme ton application Excel de suite

Code :

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

1
2
3
4
5
6
7
8
9
'.....
 
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
T = Fe.Range("A2:I" & Fe.Range("A" & Rows.Count).End(xlUp).Row)
XlClas.Close False        'on ferme le classeur SANS SAUVEGARDER
XlApp.Quit
'....

**WalTT** · 26/02/2019, 16h48

J'ai modifié mais ça plante toujours a:

Code :

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

T = Fe.Range("A2:I" & Fe.Range("A" & Rows.Count).End(xlUp).Row)

Tant que Outlook est ouvert, on voit Excel ouvert dans le gestionaire des taches. Et donc si on relance la procédure sans avoir fermé Outlook au préalable ça plante.

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
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
 
 
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, , , , "Topsecret")
    'Set XlClas = XlApp.Workbooks.Open(Chemin, UpdateLinks = False, , , "BDDMP2017")
 
    XlApp.Run "'" & XlClas.Name & "'!" & "CTRLdate"
    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)
    XlClas.Close True    'on ferme le classeur
    XlApp.Quit    'On quitte Excel
    Set XlClas = Nothing
    Set XlApp = Nothing
 
'** 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 ,"
    Else: Doc3 = ""
 End If
 
 If T(i, 8) <> "" Then   'Teste date 4 en H
    Doc4 = " l'attestation de ,"
    Else: Doc4 = ""
 End If
 
 
 If T(i, 9) <> "" Then   'Teste date 5 en I
    Doc5 = " la fiche de ,"
    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
 
  '  Set XlClas = Nothing
  '  Set XlApp = Nothing
 
 
'End If
End Sub

**zenpbb** · 26/02/2019, 16h53

Bonjour,

Essaie de remplacer

Code :

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

T = Fe.Range("A2:I" & Fe.Range("A" & Rows.Count).End(xlUp).Row)

par

Code :

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

T = Fe.Range("A2:I" & Fe.Range("A" & Fe.Rows.Count).End(-4162).Row)

Par ailleurs, il semblerait que ton code s'exécute dans Outlook.
C'est donc bizarre que tu aies besoin de créer un objet OutApp. Tu devrais pouvoir le remplacer par l'objet Application de l'instance Outlook courante

Code :

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

Set OutMail = Application.CreateItem(0)

.
Surtout que tu crées une instance Outlook pour chaque fournisseur. Au pire, si vraiment tu en as besoin, tu devrais déplacer

Code :

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

Set OutApp = CreateObject("Outlook.Application")

avant de rentrer dans la boucle et libérer l'objet après.

**WalTT** · 26/02/2019, 17h04

Code :

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

1
2
 ' T = Fe.Range("A2:I" & Fe.Range("A" & Rows.Count).End(xlUp).Row)
    T = Fe.Range("A2:I" & Fe.Range("A" & Fe.Rows.Count).End(-4162).Row)

En faisant seulement ça, ça marche.

Merci énormément

Erreur 1004 ou 462 [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager