Actualiser un document avec Excel hebdomadaire reçu par Outlook

Question

Je suis en train de mettre à jour les informations dans mon tableau de bord avec des informations reçues deux feuilles Excel reçues chaque semaine dans deux documents (InfoPrivate, InfoPublic). Mon tableau de bord contient (fondamentalement) les deux feuilles (InfoPrivate, InfoPublic), et d'autres où je fais le calcul local.

Comment puis-je mettre à jour l'info ny à la recherche de l'e-mail récent et modifier chacune des données de ces deux feuilles par la version la plus récente?

Mon code actuel est le suivant:

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 

    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 

      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 

      sht.Copy 
      ActiveWorkbook.Sheets("PAHO").Paste 

      wb1.Close 

      ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlsm 

      Set sht = Nothing: Set wb1 = Nothing: Set wb2 = Nothing: 

      isAttachment = True 

      Wend 
      msg.Delete 
     End If 
    Next 
Exit Sub 
Crash: 
MsgBox ("BOOOM") 
End Sub 

Il doesnt travail !!! Et je n'ai même pas la moindre idée pourquoi ...

Merci beaucoup à ceux qui peuvent m'aider! Dav

Answer 1

J'ai enfin réussi à le faire fonctionner!

Voici le code:

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 

    Dim MyPath As String 

    Dim sht As Worksheet 
    Dim wb1 As Workbook 
    Dim wb2 As Workbook 

    Set wb1 = ActiveWorkbook 
    Set Ol = New Outlook.Application 
    Set NameSpace = Ol.GetNamespace("MAPI") 

    Set Dossier = NameSpace.GetDefaultFolder(6).Folders("I - Vientas semanal") 

On Error GoTo Crash1 

    For Each msg In Dossier.Items 

If DateDiff("d", msg.CreationTime, wb1.Sheets("Dashboard").Range("C2")) <= 0 Then 
      If msg.Subject = "source1" Then 

       MyPath = "C:\Users\i0303644\Documents\Y- Others\Vientas semanal\S1" 
       If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" 

       msg.Attachments.Item(1).SaveAsFile MyPath & _ 
       msg.Attachments.Item(1).DisplayName 

       Set wb2 = Application.Workbooks.Open(MyPath & "\s1") 
       Set sht = wb2.Worksheets(1) 

       sht.Range("C11:AQ129").Copy wb1.Sheets("PAHO").Range("C11") 

       wb2.Close 

       MsgBox "S1 actualized with: " & msg.Subject & " " & msg.ReceivedTime 

      ElseIf msg.Subject Like "Source2*" Then 

       MyPath = "C:\Users\i0303644\Documents\Y- Others\Vientas semanal\S2" 
       If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" 

       msg.Attachments.Item(1).SaveAsFile MyPath & _ 
       msg.Attachments.Item(1).DisplayName 

       Set wb2 = Application.Workbooks.Open(MyPath & "\S2") 
       Set sht = wb2.Worksheets(1) 

       sht.Range("C9:AB115").Copy wb1.Sheets("Private_&_others").Range("C9") 

       wb2.Close 

       MsgBox "S2 actualized with: " & msg.Subject & " " & msg.ReceivedTime 

      End If 

'ElseIf Count(DateDiff("d", msg.CreationTime, wb1.Sheets("Dashboard").Range("C2")) <= 0) = 0 Then 
'MsgBox "There are no new data" 
End If 

Next msg 

wb1.Sheets("Dashboard").Range("C2").Value = Date 
Set wb1 = Nothing: Set wb2 = Nothing: Set sht = Nothing: 

Exit Sub 
Crash1: 
MsgBox ("Sometehing is not working") 
End Sub 

Bye!

Answer 2

vous avez besoin

1. un moyen de sauvegarde automatique du dernier e-mail reçu à un emplacement prédéfini (Google vous donnera une tonne de résultats)
2. en supposant que vous utilisez Excel pour votre tableau de bord , reconstruire et utiliser l'énergie requête pour importer les données des fichiers à l'emplacement prédéfini
3. puissance requête relisez la source feuilles excel et mettre à jour le tableau de bord