Forcer la fenetre d'envoi outlook en premier plan Access 2013/16

Bonjour HDU,

Ca fonctionne presque, j'ai un message d'erreur qui s'affiche derrière la fenetre du mail Outlook, je pense que je n'ai pas placé le code au bon endroit,

Je remet mon code au cas ou si tu peux me dire exactement ou le placer, sinon je vais essayer de moi même de le placer différement.

Le code complet :

Public sngDimLab As Single
Public sngTexec As Single
Public i As Long

Sub BILAN_RT_LD()

Dim Rep As Integer
    
    Rep = MsgBox("Vous allez charger et envoyer le bilan de la journée de production du :" & Chr(13) & Chr(13) & "                  " & Format(Form_F_MENU_RT_LD_PRIMAIRE.BILANLD, "Long Date") & Chr(13) & Chr(13) & "Merci de patientez jusqu'à la fin du chargement.", vbYesNo + vbQuestion + vbSystemModal, "Aperçu Bilan Lettre Départ")
   If Rep = vbNo Then
        Else

sngTexec = 0

With UserFormLD
    sngDimLab = .Label1.Width * 1 / 3 '<-- 3 = le nombre de procédure
    .Label1.Width = 0
    .Show 0
    
End With

'exécution procédure 1
Proc1
USF

'exécution procédure 2
Proc2
USF

'exécution procédure 3
Proc3
USF

Unload UserFormLD
MsgBox "Chargements des données vers Outlook terminé.", vbOKOnly + vbInformation, "Organisation et Process - VLG PIC 92"


End If

End Sub

Private Sub USF()
sngTexec = sngTexec + sngDimLab
UserFormLD.Label1.Width = sngTexec
UserFormLD.Repaint
End Sub

Private Sub Proc1()
For i = 1 To 2000   'pour simuler le temps d'exécution de la procédure
Next
' nom du fichier pdf temporaire
cheminfichier = "U:\Public\3.Production\commun\organisation\Export_GPF_(ne pas modifier)\Tempo_EMAIL\E72_BILAN_LD_Rech.pdf"
' création du fichier pdf
DoCmd.OutputTo acOutputReport, "E72_BILAN_LD_Rech", acFormatPDF, cheminfichier
End Sub
Private Sub Proc2()
For i = 1 To 2000   'pour simuler le temps d'exécution de la procédure
Next
' nom du fichier pdf temporaire
cheminfichier2 = "U:\Public\3.Production\commun\organisation\Export_GPF_(ne pas modifier)\Tempo_EMAIL\B72_RETARD_BILAN_LD_Rech.pdf"
' création du fichier pdf
DoCmd.OutputTo acOutputReport, "B72_RETARD_BILAN_LD_Rech", acFormatPDF, cheminfichier2
End Sub

Private Sub Proc3()
For i = 1 To 2000   'pour simuler le temps d'exécution de la procédure
Next
   ' Initialisation :
   Dim ListeEMail As DAO.Recordset
   Set ListeEMail = CurrentDb.OpenRecordset("R_EMAIL_LD")
   ListeEMail.MoveFirst
   ListeComplete = ""
  
   ' Parcourt de la requête :
   While Not ListeEMail.EOF
   ListeComplete = ListeComplete & ListeEMail("EMail") & ";"
   ListeEMail.MoveNext
   Wend
  
   ' On enlève le dernier point virgule :
   ' ListeComplete nous sera évidemment utile tout à l'heure :
   ListeComplete = Left(ListeComplete, Len(ListeComplete) - 1)
  
   ' Stop DAO :
   ListeEMail.Close
   Set ListeEMail = Nothing
 
   ' #######################################
   ' # 2. Envoi de l'E-Mail avec Outlook : #
   ' #######################################

   
   ' Initialisation :
   Dim MonOutlook As Object
   Dim MonMessage As Object
   Set MonOutlook = CreateObject("Outlook.Application")
   Set MonMessage = MonOutlook.createitem(0)
   
  ' nom du fichier pdf temporaire
  cheminfichier = "U:\Public\3.Production\commun\organisation\Export_GPF_(ne pas modifier)\Tempo_EMAIL\E72_BILAN_LD_Rech.pdf"
  cheminfichier2 = "U:\Public\3.Production\commun\organisation\Export_GPF_(ne pas modifier)\Tempo_EMAIL\B72_RETARD_BILAN_LD_Rech.pdf"
  
   ' Préparation du message :
   MonMessage.To = "orga.pic-villeneuve@laposte.fr"
   MonMessage.CC = "orga.pic-villeneuve@laposte.fr"

   ' Récupération de la chaîne d'E-Mails Access :
   MonMessage.To = ListeComplete
   MonMessage.Subject = "Bilan de Production Lettre Départ"
   MonMessage.HTMLBody = corps
    
   ' Ajout de la signature
   MonMessage.HTMLBody = MonMessage.HTMLBody & "<br/>" & "<br>" & Signature("Signature")
   
   ' Ajout des pièces jointes
   MonMessage.Attachments.Add cheminfichier
   MonMessage.Attachments.Add cheminfichier2
   MonMessage.display vbSystemModal = False
   
Set OLk_appli = GetObject( "Outlook.Application") 
If OLk_Appli Is Nothing Then 
OLk_OK= Shell("C:\Program Files\Microsoft Office\Office10\OUTLOOK.EXE", 1) 
end if  

   ' supprimer le fichier pdf après envoi du message
   Kill (cheminfichier)
   Kill (cheminfichier2)
   
End Sub
Private Function Signature(nom_signature As String) As String
    Dim FSO As Object, TextStream As Object
    Dim nom_fichier As String
     
    Signature = Empty
    On Error Resume Next
    Set FSO = CreateObject("Scripting.FileSystemObject")
    nom_fichier = Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & ".htm"
    Set TextStream = FSO.OpenTextFile(nom_fichier)
    If Err.Num = 0 Then
        Signature = TextStream.ReadAll
        'remplacement adresse relative images par adresse absolue
        Signature = Replace(Signature, nom_signature & "_files/", Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & "_files/")
    Signature = Replace(Signature, nom_signature & "_fichiers/", Environ("APPDATA") & "\Microsoft\Signatures\" & nom_signature & "_fichiers/")
    End If
End Function

Un exemple qui rentre dans les 10% des cas,

Je travail sur 2 écrans, sur l’ecran de gauche, qui est mon écran principal, je lance la procédure depuis la base access et pendant le traitement je clique sur l’ecran de droite, par exemple pour ouvrir un fichier Excel, forcément la fenêtre Outlook du mail s’ouvre dans la barre des tâches et non en premier plan sur l’ecran de gauche.

La plus part des utilisateurs, a mon travail, utilisent qu’un seul écran donc je ne pense pas que le problème ce présente, j’ai juste remarqué cela sur mon poste à moi car j’ai 2 écrans.

Je vais tester en enlevant systemmodal, je voulais juste que l’uitilisateur ne puisse pas retourner sur la base de donnée tant qu’il n’a pas fermer son mail, soit il l’envoi soit il l’enregistre et retour sur le formulaire.