Plantage de base à l'ouverture d'outlook

**lololebricoleur** · 10/12/2019, 11h19

Bonjour,

Dans ma base (factionnée et partagée), j'utilise outlook pour gérer l'envoi ds emails.
Ça fonctionne bien sur la plupart des poste sauf 1 notamment.

Sur se poste utilisateur (en Windows 7), quand Outlook s'ouvre, la base qui est en arrière plan se fige (écran gris).
Ça n'est pas systématique mais il semble que se soit de plus en plus fréquent.
Obligé de la quitter par le gestionnaire de tâche.

Le code qui appel Outlook :

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
Private Sub B_Envoyer_Click()
 
    'Déclaration des variables
    Dim MonOutlook As New Outlook.Application
    Dim MonMessage As Outlook.MailItem
    Dim MyAttachments As Outlook.Attachments
    Dim Msg As String
    Dim MsgAuto As String
    Dim IntroLibre As String
    Dim IntroAuto As String
    Dim Signature As HTMLText
    Dim Con As ADODB.Connection
    Dim Jeu_Enr As ADODB.Recordset
    Dim Jeu_Enr_ses As ADODB.Recordset
    Dim txt As String
 
    'Vérification du mode test
    If Table_INF = "" Then Table_INF = "INFormation_Test"
    If Chemin = "" Then Chemin = "C:\"
 
    'Initialisation des objets
    Set MonMessage = MonOutlook.CreateItem(0)
    Set MyAttachments = MonMessage.Attachments
    Set Con = CurrentProject.Connection
    Set Jeu_Enr = New ADODB.Recordset
    Set Jeu_Enr_ses = New ADODB.Recordset
 
    'Gestion des pièces jointes
    If Me.S_Bulletin_PDF = -1 Then
        DoCmd.OutputTo acOutputReport, "E_Doc_Envoi_Info_Bi", acFormatPDF, Chemin & "Bulletin d'inscription.pdf"
        MyAttachments.Add Chemin & "Bulletin d'inscription.pdf" ', olByValue, 1, "Test 11111"
    End If
 
    If Me.S_Programme_PDF = -1 Then
        DoCmd.OutputTo acOutputReport, "E_Doc_Programme_OPQF", acFormatPDF, Chemin & "Programme de formation.pdf"
        MyAttachments.Add Chemin & "Programme de formation.pdf" ', olByValue, 1, "Test 11111"
    End If
 
    SQl = "SELECT " & Table_INF & ".INF_Chemin, " & Table_INF & ".INF_Select, " & Table_INF & ".INF_Désignation" & _
    " From " & Table_INF & _
    " WHERE (((" & Table_INF & ".INF_Select)=True));"
 
    Jeu_Enr.Open SQl, Con, adOpenForwardOnly, adLockReadOnly
 
    SQl = "SELECT SESsions.*, REPertoire.*, STAge.*" & _
    " FROM STAge RIGHT JOIN (SESsions LEFT JOIN REPertoire ON SESsions.SES_Lieu = REPertoire.REP_Num) ON STAge.STA_Num = SESsions.SES_Stage" & _
    " WHERE (((SESsions.SES_Num)=" & Me.SES_Num & "));"
 
    'SELECT SESsions.*, REPertoire.*
    'FROM SESsions LEFT JOIN REPertoire ON SESsions.SES_Lieu = REPertoire.REP_Num
    'WHERE (((SESsions.SES_Num)="SES_Num"));
 
    Jeu_Enr_ses.Open SQl, Con, adOpenForwardOnly, adLockReadOnly
 
    Do While Not Jeu_Enr.EOF
 
        If Dir(Jeu_Enr!INF_Chemin) <> "" Then
        'MyAttachments.Add Jeu_Enr!INF_Chemin, olByValue, 1, "Test 11111"
        txt = Jeu_Enr!INF_Chemin
        MyAttachments.Add txt 'Jeu_Enr!INF_Chemin
        End If
 
        Jeu_Enr.MoveNext
    Loop
 
    'Création du message
    IntroAuto = "<FONT size='3'><FONT face='tahoma'>Bonjour,<br/><br/>Comme convenu, veuillez trouver ci-joints les documents et les informations relatifs à la formation : " & DLookup("STA_Titre", "STAge", "STA_Num =" & Me.SES_STA) & "."
    IntroLibre = "Bonjour,"
 
    Do While Not Jeu_Enr_ses.EOF
        MsgAuto = MsgAuto & "<br/>   - Durée : " & Jeu_Enr_ses!STA_Duree_j & " jour(s)"
        MsgAuto = MsgAuto & "<br/>   - Lieu : " & Jeu_Enr_ses!REP_Ville
        If (Jeu_Enr_ses!STA_Duree_j > 1) Then
            MsgAuto = MsgAuto & "<br/>   - Dates : Du " & Jeu_Enr_ses!SES_DD & " au " & Jeu_Enr_ses!SES_DF
        Else
            MsgAuto = MsgAuto & "<br/>   - Date : Le " & Jeu_Enr_ses!SES_DD
        End If
 
        Jeu_Enr_ses.MoveNext
    Loop
 
    If Me.S_Lien_Programme = -1 Then MsgAuto = MsgAuto & "<br/><br/> Vous pouvez également consulter le programme et vous inscrire directement sur notre nouveau site Internet en cliquant sur les liens ci-dessous  : <br/>   - Pour consulter le programme de la formation : " & "<a href=https://anofab.fr/" & Me.SES_STA & " >Cliquez ici</a><br/>"
    If Me.S_Lien_Inscription = -1 Then MsgAuto = MsgAuto & "   - Pour vous inscrire par Internet : <a href=http://www.anofab.fr/formation/stage/" & Me.SES_STA & "/" & Me.SES_Num & ">Cliquez ici</a>"
 
    Select Case Me.S_Type_Message
        Case 1 'Message automatique
        Msg = IntroAuto & MsgAuto
 
        Case 2 'Message libre
        Msg = Me.SAI_Message
 
        Case 3 'Message automatique + message libre
        Msg = IntroAuto & MsgAuto & Me.SAI_Message
 
        Case 4 'Message libre + message automatique
        Msg = Me.SAI_Message & MsgAuto
 
        Case Else: Exit Sub
    End Select
 
 
    Msg = Msg & "<br/><br/>Je reste à votre disposition pour toute information complémentaire, n'hésitez pas à me contacter.<br/><br/>Bien cordialement,"
 
    With MonMessage
    If Me.Voir = -1 Then
        .Display
    Else
        .Send
    End If
    .To = Me.Destinataire 'destinataire
    .Subject = Me.Objet 'objet
    .HTMLBody = Msg & .HTMLBody
 
    End With
 
    'Déselection des documents
    SQl = "UPDATE " & Table_INF & " SET " & Table_INF & ".INF_Select = False" & _
    " WHERE (((" & Table_INF & ".INF_Select)=True));"
 
    DoCmd.SetWarnings False 'désactive les messages d'info auto
    DoCmd.RunSQL SQl
    DoCmd.SetWarnings True 'active les messages d'info auto
 
    'désallocation des objets
    Set MonOutlook = Nothing
    'Set ListeEMail = Nothing
    Jeu_Enr.Close
    Set Con = Nothing
 
    DoCmd.Close
 
End Sub

Voyez vous un problème ou auriez vous une hypothèse d'explication svp ?

Merci d'avance

**PipoWIL** · 10/12/2019, 11h27

Bonjour,
Si la base Access fonctionne bien sur les autres postes, le problème ne vient-il pas de Outlook sur ce poste-là. L'utilisateur a-t-il une autre version de Outlook ? A-t-il des macros VBA sur son Outlook ?

**lololebricoleur** · 10/12/2019, 13h21

Merci PipoWIL,

La version d'outlook est la même à priori (2010 pro)
Pas de macros créées ou installées
Un différence avec les autres c'est que c'est l'un des derniers à être en Windows 7

**PipoWIL** · 10/12/2019, 13h57

Bonjour,
Vous travaillez avec Outlook. Je suppose que dans votre module VBA vous avez défini la référence à Outlook (Menu Tools/References....). Sur le PC en question, cette référence est-elle la même ?
Pour éviter ces problèmes de référence, renseignez-vous sur "early binding" / "late binding".

**lololebricoleur** · 10/12/2019, 16h04

Merci PipoWil, je vais vérifier ça.

**lololebricoleur** · 10/12/2019, 16h15

Question PipoWIL,

Au démarrage des postes utilisateur, le fichier de la base frontale est systématiquement copié depuis le serveur vers le poste client.
Je suppose que les référence sont attachées au fichier source et suive se fichier, y compris s'il est copié non ?

Merci

**lololebricoleur** · 10/12/2019, 16h24

Bon, je viens de faire la vérification, la référence est la même sur se poste que sur les autres.
La référence : Microsoft Outlook 14.0 Object Library

**PipoWIL** · 10/12/2019, 16h38

Oui, les références suivent.
Ce qui peut arriver c'est que vous développiez votre application sur votre beau PC tout neuf et que vous y attachiez la référence "Microsoft Outlook 16.0 Object library" (ou qqch du genre).
Vous testez : tout marche bien. Formidable ! Avec in sourire allant d'une oreille à l'autre, vous installez sur les vieux PC des utilisateurs et patatras ! Lorsque ceux-ci essayent, ils ont une erreur et quand on va voir dans les références on voit qqch du genre "MISSING : Microsoft Outlook 16.0 Object library" parce que sur leur PC ils ont encore la version 14 ou 12 ou 11...

D'après votre dernier message, je comprends que vous avez vérifié et qu'on peut éliminer cette erreur.

**PipoWIL** · 10/12/2019, 16h41

Devloppez.com est un site plein de ressources ! Etes-vous allé voir du côté du Forum Outlook ?

**lololebricoleur** · 10/12/2019, 17h02

Non, effectivement, je vais regarder de ce côté aussi

Merci de votre aide

**Thierry_PALLIER** · 12/12/2019, 13h01

Bonjour.

Pour moi le problème ne vient pas d'Outlook mais de ton code.
Si Access devient "grisé", c'est que le code mouline et ne trouve pas de sortie.
Déjà, ta procédure est beaucoup trop chargée : des IF, des Select case, des Do While ....
Essaie de scinder tout celà en 2 ou 3 procédures ou fonctions. La dernière (proc) avec argument étant réservé à l'envoie du mail.
D'autre part, je pense que le .Display ou le .Send (ligne 106 et 108) devrait etre après une affectation de .To ....(line 110 à 112).
Voir aussi du coté des pièces jointes si elles existes, sont lisibles ...
Cdlt

**Robert1957** · 12/12/2019, 17h26

Bonjour à tous,

En complément à Thierry_PALLIER à la ligne 112 :

Code :

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

.HTMLBody = Msg & .HTMLBody

Ce bout de code va essayer de lire dans Outlook, pour récupérer la signature probablement. Il faut que l'utilisateur ait la permission pour faire cela.

Bonne journée

Plantage de base à l'ouverture d'outlook

VBA Access

Discussions similaires

Partager

Partager