Dashboard actualise mensuellement par email

Cher tous,

Je me pose une question: est-il possible de faire un dashboard qui s actualise de maniere hebdomadaireen allant chercher un autre doc Excel dans Outlook?

Je m´explique: je recois toutes les semaines deux documents aux formats constants, mais actualisés avec les ventes de la semaine. Le titre et l´envoyeur sont egalement toujours les memes (et ne contiennent pas de dates).

On me demande d envoyer un document de sytnthese comparant ces ventes avec les previsions (qui elles sont fixes).

Pensez vous que ce soit possible de recuperer ces donnees de maniere automatiques?

Voici ou j en suis:

Public Sub SaveOlAttachmentsPU()
  Dim isAttachment As Boolean
  Dim olFolder As Outlook.MAPIFolder
  Dim msg As Outlook.MailItem
  Dim att As Outlook.Attachment
  Dim sht As Worksheet, wb1, wb2 As Workbooks
  Dim plage As Range

  On Error GoTo crash

  isAttachment = False

  Set olFolder = Outlook.GetNamespace("MAPI").Folders(1)
  Set olFolder = olFolder.Folders("Inbox")

  If olFolder Is Nothing Then Exit Sub
     For Each msg In olFolder.Items
        If UCase(msg.Subject) = "PAC PAHO Sales Current Year" Then

            While msg.Attachments.Count > 0
            '1. Copie de la piece jointe
            Set wb1 = msg.attachements.Open
            wb1.Sheets("PAC PAHO Sales Current Year").Copy    'on copie la feuille de la piece jointe
            Set sht = ActiveSheet                             'on récupère la copie dans un objet

            '2. Copier-coller
            sht.Copy
            ActiveWorkbook.Sheets("PAHO").Paste

            '3. Fermer doc à copier
            wb1.Close

            '4. Enregistrer synthèse
            ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlsm

            '5. Libérer objets
            Set sht = Nothing: Set wb1 = Nothing: Set wb2 = Nothing:

            isAttachment = True

            Wend
            msg.Delete
        End If
     Next

Exit Sub
Crash:
MsgBox ("il y a un truc qui foire!")
End Sub

Evidemment ca ne marche pas (encore),mais je ne sais pas ou ca coince!

Merci d avance á ceux qui prendront le temps de maider!

Cordialement,

draynaud

Bon j ai tenté une seconde version:

Sub ExportOlAttachments()
  Dim Ol As New Outlook.Application
  Dim NameSpace As Outlook.NameSpace
  Dim Dossier As Outlook.MAPIFolder
  Dim Elements As Outlook.Items
  Dim msg As Outlook.MailItem

  Set Ol = New Outlook.Application
  Set NameSpace = Ol.GetNamespace("MAPI")
  Set Dossier = NameSpace.GetDefaultFolder(olFolderInbox)
  Set Elements = Dossier.Items

  On Error GoTo Crash1

  'Both type of email
  Dossier.Sort "PAC PAHO Sales Current Year" & "PAC Private & Other Public Sales Current Year- ****-**-**"
  'Most recent email - la par exemple je n ai aucune idee de cmment faire mais je voudrais en fait ne garder
  'que le dernier en date pour chacun des deux emails que je recois

  Dossier.Sort

  For Each msg In Dossier
        If UCase(msg.Subject) = "PAC PAHO Sales Current Year" Then
            msg.Attachments.Copy
            ThisWorkbook.Sheets("PAHO").Paste

        ElseIf UCase(msg.Subject) = "PAC Private & Other Public Sales Current Year" Then
            msg.Attachments.Copy
            ThisWorkbook.Sheets("Private_&_Others").Paste

        End If
  Next msg

  MsgBox ("Dale papito")

Exit Sub
Crash1:
MsgBox ("il y a un truc qui foire parajo")
End Sub

Au cas ou cela interesse quelqu un!