Private Sub Form_Load() On Error GoTo ErrHandler ' Affiche la feuille pour activer la boîte de dialogue de connexion. Me.Show ' Démarre une session MAPI. mpsSession.DownLoadMail = True mpsSession.LogonUI = True mpsSession.SignOn mpmMessages.SessionID = mpsSession.SessionID ' Lecture des messages à partir du serveur. FetchMessages ' S'il y a des messages, affichage du premier. If listMessages.ListCount > 0 Then listMessages.ListIndex = 0 listMessages_Click End If Exit Sub ErrHandler : CriticalError End Sub Public Sub CriticalError() ' Erreur ! ' Message d'information et fin du programme. MsgBox Error$, vbCritical, "Erreur critique : " & Str(Err) If mpsSession.SessionID Then mpsSession.SignOff End If End End Sub Public Sub FetchMessages() Dim intMsgIndex As Integer On Error GoTo ErrHandler ' Lecture des messages sur le serveur ' et les trie . mpmMessages.FetchSorted = True mpmMessages.FetchUnreadOnly = False mpmMessages.Fetch ' Mise à jour de la liste déroulante. listMessages.Clear intMsgIndex = 0 If mpmMessages.MsgCount > 0 Then Do mpmMessages.MsgIndex = intMsgIndex listMessages.AddItem mpmMessages.MsgSubject intMsgIndex = intMsgIndex + 1 Loop Until (intMsgIndex = mpmMessages.MsgCount) End If ErrHandler : CriticalError End Sub Private Sub cmdMsgNew_Click() On Error GoTo ErrHandler ' Création nouveau message. mpmMessages.Compose mpmMessages.Send True listMessages.SetFocus Exit Sub ErrHandler: CriticalError End Sub Private Sub cmdMsgReply_Click() On Error GoTo ErrHandler ' Réponse au message . mpmMessages.MsgIndex = listMessages.ListIndex mpmMessages.Reply mpmMessages.Send True listMessages.SetFocus Exit Sub ErrHandler: CriticalError End Sub Private Sub cmdMsgReplyAll_Click() On Error GoTo ErrHandler ' Réponse à tous les destinataires du message. mpmMessages.MsgIndex = listMessages.ListIndex mpmMessages.ReplyAll mpmMessages.Send True listMessages.SetFocus Exit Sub ErrHandler: CriticalError End Sub Private Sub cmdMsgForward_Click() On Error GoTo ErrHandler ' Transfère le message à un autre destinataire. mpmMessages.MsgIndex = listMessages.ListIndex mpmMessages.Forward mpmMessages.Send True listMessages.SetFocus Exit Sub ErrHandler: CriticalError End Sub Private Sub cmdMsgCopy_Click() On Error GoTo ErrHandler ' Copie du message. mpmMessages.MsgIndex = listMessages.ListIndex mpmMessages.Copy mpmMessages.Send True listMessages.SetFocus Exit Sub ErrHandler: CriticalError End Sub Private Sub cmdMsgDelete_Click() On Error GoTo ErrHandler ' Détruit le message Mise à jour de la liste déroulante. mpmMessages.MsgIndex = listMessages.ListIndex mpmMessages.Delete listMessages.RemoveItem listMessages.ListIndex If listMessages.ListCount > 0 Then listMessages.ListIndex = 0 Else lblMsgInfo = "" txtMsgBody = "" End If listMessages.SetFocus Exit Sub ErrHandler: CriticalError End Sub Private Sub listMessages_Click() ' Lorsque l'utilisateur clique sur un message, ' affichage des informations (expéditeur, sujet et date) ' dans un label et du texte du message dans la zone textMsgBody. mpmMessages.MsgIndex = listMessages.ListIndex lblMsgInfo = "De: " + mpmMessages.MsgOrigDisplayName + Chr$(13) _ + "Sujet: " + mpmMessages.MsgSubject + Chr$(13) _ + "Date: " + mpmMessages.MsgDateReceived txtMsgBody = mpmMessages.MsgNoteText End Sub Private Sub cmdAddrBook_Click() On Error GoTo ErrHandler ' Affichage du Carnet d'adresses. mpmMessages.Show listMessages.SetFocus Exit Sub ErrHandler: CriticalError End Sub Private Sub cmdExit_Click() Dim intExit As Integer ' Demande de confirmation. intExit = MsgBox("Quitter le programme ?", vbYesNo, _ "Fin du programme") If intExit = vbYes Then mpsSession.SignOff End End If listMessages.SetFocus End Sub Private Sub txtMsgBody_KeyPress(KeyAscii As Integer) 'Protection de la zone texte du message. KeyAscii = 0 End Sub