Sub Enregistrer_PJ()

   Dim MonOutlook As New Outlook.Application
   Dim MesDossiers As NameSpace
   Dim MonDossier As MAPIFolder
   Dim NombreMails, NombrePiecesJointes As Integer
   Dim Boucle As Long
   Dim MaPieceJointe As Outlook.Attachment
   Dim DateMail, DateRapport As Date
   Dim NomPieceJointe As String

   ' Blocage du calcul automatique et de l'affichage
   Application.Calculation = xlManual
   Application.ScreenUpdating = False
   Set MonOutlook = Outlook.Application
   Set MesDossiers = MonOutlook.GetNamespace("MAPI")
   On Error Resume Next
   Set MonDossier = MesDossiers.GetDefaultFolder(olFolderInbox)

   ' Positionnement sur la boîte de réception
   If Err.Number <> 0 Then
      Err.Clear
      MsgBox "Le dossier ""Boîte de réception"" n'existe pas"
      ' Déblocage du calcul automatique et de l'affichage
      Application.Calculation = xlAutomatic
      Application.ScreenUpdating = True
      Exit Sub
   End If

   ' Décompte du nombre de mails dans la Boîte de Réception
   NombreMails = MonDossier.Items.Count
   NombrePiecesJointes = 0

   If NombreMails < 1 Then
      MsgBox "Le dossier ""Boîte de réception"" ne contient aucun mail"
      ' Déblocage du calcul automatique et de l'affichage
      Application.Calculation = xlAutomatic
      Application.ScreenUpdating = True
      Exit Sub
   End If

   ' Chargement de la fenêtre d'attente
   FormulaireAttente.BarreProgression.Value = 0
   FormulaireAttente.BarreProgression.Max = NombreMails
   FormulaireAttente.Show vbModeless

   For Boucle = 1 To NombreMails
      
      Set MonMail = MonDossier.Items(Boucle)

      ' Test si le mail sélectionné est bien pour GMAO
      If InStr(1, MonMail, "LAKE") <> 0 Then

         ' Test si présence d'une pièce jointe
         If MonMail.Attachments.Count > 0 Then
   
            ' Récupération du nom de la pièce jointe
            Set MaPieceJointe = MonMail.Attachments(1)
 
            ' Récupération de la date de création du mail
            DateMail = MonMail.CreationTime
            DateRapport = DateAdd("d", -1, DateMail)

            ' Ajout de la date au nom de la pièce jointe
            NomPieceJointe = Left(MaPieceJointe, InStr(1, MaPieceJointe, ".") - 1) + " - " + Format(Year(DateRapport), "#") + "-" + Right("0" + Format(Month(DateRapport), "#"), 2) + "-" + Right("0" + Format(Day(DateRapport), "#"), 2) + ".pdf"

            ' Sauvegarde de la pièce jointe
            MaPieceJointe.SaveAsFile "C:\LAKE\" & NomPieceJointe
            NombrePiecesJointes = NombrePiecesJointes + 1

            ' Supression du mail
            MonMail.Delete
            NombreMails = NombreMails - 1
            Boucle = Boucle - 1

         End If

      End If

      FormulaireAttente.BarreProgression.Value = Boucle

   Next Boucle

   ' Fermeture de la fenêtre d'attente
   FormulaireAttente.Hide
   Unload FormulaireAttente

   If NombrePiecesJointes = 0 Then
      MsgBox "Aucun Rapport n'a été trouvé !"
   ElseIf NombrePiecesJointes = 1 Then
      MsgBox NombrePiecesJointes & " Rapport a bien été sauvegardé !"
   Else
      MsgBox NombrePiecesJointes & " Rapports ont bien été sauvegardés !"
   End If

   Set MonOutlook = Nothing
   Set MesDossiers = Nothing
   Set MonDossier = Nothing

   ' Déblocage du calcul automatique et de l'affichage
   Application.Calculation = xlAutomatic
   Application.ScreenUpdating = True

End Sub