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

我收到错误＆＃34;错误的参数数量或无效的属性分配＆＃34;在与之后的两行。

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

Answer 1

外观：命名空间（Atchmt.FileName）.Items 建议有几个项目。您试图将它们全部收集在一个项目中。

尝试对于n = 1到（附件数量）命名空间（Atchmt.FileName）.Items（n）的 ......等......

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

1 个答案: