Outlook VBA décompresser pièce jointe et enregistrer dans le dossier

Question

Je reçois des e-mails générés par le système à partir d'un système ERP contenant des fichiers .zip, dans le fichier zip est un fichier Excel qui contient des données que je voudrais importer dans un tableau de bord que j'ai fabriqué.

Au moment où j'ai ce code qui permet de gagner avec succès la pièce jointe .zip dans le dossier lorsque je reçois l'e-mail:

Sub saveAttachment2(Item As Outlook.MailItem) 
Dim selItems   As Selection 
Dim objItem    As Object 
Dim iCount    As Integer 
Dim atmts     As Attachments 
Dim oAttachment As Attachment 
Dim sSaveFolder As String 

Set selItems = ActiveExplorer.Selection 
sSaveFolder = "C:\Users\212357980\Documents\Accounts Coordination\Oracle Exports\" 
For Each objItem In selItems 
    Set atmts = objItem.Attachments 
    For Each oAttachment In atmts 
     oAttachment.SaveAsFile sSaveFolder & "\Service Requests.zip" 
    Next 
Next 
End Sub 

Maintenant, je voudrais à décompresser le fichier avant qu'il enregistre dans l'emplacement, ce que j'ai jusqu'à présent:

Sub Unzip2() 

    Dim ns As NameSpace    'variables for the main functionality 
    Dim Inbox As MAPIFolder 
    Dim SubFolder As MAPIFolder 
    Dim Atchmt As Attachment 
    Dim FileName As String 
    Dim msg As Outlook.MailItem 

    Dim FSO As Object    'variables for unzipping 
    Dim oApp As Object 
    Dim FileNameFolder As Variant 
    Set ns = GetNamespace("MAPI") 
    Set Inbox = ns.GetDefaultFolder(olFolderInbox) 
    Set SubFolder = Inbox.Folders("Sales Orders") 

    For Each msg In SubFolder.Items 
      For Each Atchmt In msg.Attachments 
        If (Right(Atchmt.FileName, 3) = "zip") Then 

            FileNameFolder = "C:\Users\212357980\Documents\Accounts Coordination\Oracle Exports\" 
            Set oApp = CreateObject("Shell.Application") 
            With oApp 
             .NameSpace(FileNameFolder).CopyHere 
             .NameSpace(Atchmt.FileName).Items 
            End With 

            On Error Resume Next 
            Set FSO = CreateObject("scripting.filesystemobject") 
           FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True 
        End If 
      Next 
    Next 
End Sub 

je reçois l'erreur « le nombre d'arguments ou assignation de propriété non valide » sur les deux lignes après la avec.

Toute aide que vous pouvez fournir serait géniale!

Answer 1

regard: NameSpace (Atchmt.FileName) .Les éléments suggèrent qu'il y a plusieurs éléments. Vous essayez de les rassembler tous dans un seul article.

Essayez pour n = 1 à (nombre de pièces jointes) namespace (Atchmt.FileName) .Items (n) .. etc ...