Outlook VBA 解压缩附件并保存到文件夹

Question

我收到来自 ERP 系统的系统生成的电子邮件，其中包含 .zip 文件，zip 文件内是一个 excel 文件，其中包含我想导入到我制作的仪表板中的数据。

目前我有这个代码，当我收到电子邮件时，它成功地将 .zip 附件保存到文件夹中：

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

现在我希望它在将文件保存到该位置之前解压缩文件，这是我到目前为止所拥有的：

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

我在 with 之后的两行收到错误“参数数量错误或属性分配无效”。

您能提供的任何帮助都会很棒！

Answer 1

看： NameSpace(Atchmt.FileName).Items 表明有几个项目。 您正试图将它们全部收集在一件物品中。

尝试 n = 1 到（附件数） NameSpace(Atchmt.FileName).Items(n) .. 等 ...