Sub ExcelPj()
'Déclarations
Const dossier As String = "L:\Temp\"

Dim nbPj As Integer
Dim numPj As Integer
Dim monNom As String
Dim courrier As MailItem
Dim inspecteur As Inspector
Dim rep As Long
Dim extension As String
Dim i As Long
Dim pos As Long
  Set inspecteur = ActiveInspector
  ' y a t-il un affichage d'item actif
  If inspecteur Is Nothing Then
    MsgBox "Afficher un courrier, traitement abandonné", vbCritical
    Exit Sub
  End If
  'Cet affichage concerne-t-il un courrier ?
  If TypeName(inspecteur.CurrentItem) <> "MailItem" Then
    MsgBox "Ce qui est affiché n'est pas un courrier, traitement abandonné", vbCritical
    Exit Sub
  End If
  Set courrier = inspecteur.CurrentItem
  nbPj = courrier.Attachments.count
  If nbPj = 0 Then
    MsgBox "Pas de pièce jointe, traitement abandonné", vbCritical
    Exit Sub
  End If
  numPj = 1
  If nbPj > 1 Then
  ' balayer les pièces jointes et s'arrêter au premier xlxs
    numPj = 0
    For i = 1 To nbPj
      pos = InStrRev(courrier.Attachments(i), ".")
      If pos > 0 Then
        extension = mid(courrier.Attachments(i), pos + 1)
        If extension = "XLSX" Then
          numPj = i
          Exit For
        End If
        
      Else
      numPj = 0
      End If
    Next i
    If numPj = 0 Then
      MsgBox "Aucune pièce jointe en xls, traitement abandonné", vbCritical
      Exit Sub
    End If
    rep = MsgBox("Seule la pièce '" & courrier.Attachments(numPj) & "'  sera recopiée", vbOKCancel)
    If rep = vbCancel Then
      Exit Sub
    End If
  End If
  'Boîte de dialogues simples pour le  nom du fichier
monNom = InputBox("Nom de sauvegarde sans le XLSX", "nom d'usine et référence")
  'sauver la pièce jointe n°i  dans le dossier
courrier.Attachments(1).SaveAsFile dossier & monNom & ".xlsx"
  
Set inspecteur = Nothing
Set courrier = Nothing
 ' ouvrir le dossier de sauvegarde
Shell "explorer.exe " & dossier, vbNormalFocus
' ouvrir le fichier avec excel
Shell "excel.exe " & dossier & monNom & ".xlsx", vbNormalFocus
  
End Sub