使用 Outlook 规则下载并解压缩压缩附件

Question

我有一个相当直接的场景，我每天都会收到一封附有 zip 文件的电子邮件，我希望能够更轻松地解析这些信息。为此，我只需要能够将附件下载到一个文件夹，然后将其解压缩。

要下载附件，我执行了以下操作

Public Sub SaveZip(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment
Dim saveFolder As String

saveFolder = "c:\temp\"

For Each objAtt In itm.Attachments
    objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
    Set objAtt = Nothing
Next


End Sub

这按预期工作，.zip 文件被转储到临时目录中。我发现以下代码在所有方面似乎都是我需要执行的代码才能提取 .zip

Set oApp = CreateObject("Shell.Application")
oApp.NameSpace(saveFolder).CopyHere oApp.NameSpace.Items

我无法在不产生大量错误的情况下将其实现到我现有的代码中（我确定是由于我自己缺乏理解）

如有任何意见，我们将不胜感激

最终编辑

知道了，感谢 Tim 的所有帮助。下面将从收到的电子邮件中下载附件（总是命名相同的东西）到 c:\temp，将它们解压缩到 c:\temp\unzipped，重命名文件，最后删除 c:\temp 中的 .zip。

Public Sub SaveZip(itm As Outlook.MailItem)

    Const saveFolder = "C:\Temp\"
    Const fileFolder = "C:\CBH\"

    Dim objAtt As Outlook.Attachment
    Dim oApp As Object
    Dim dName As Variant


    For Each objAtt In itm.Attachments

        dName = objAtt.DisplayName

        objAtt.SaveAsFile saveFolder & dName

        Set oApp = CreateObject("Shell.Application")

        oApp.NameSpace("C:\CBH").CopyHere _
           oApp.NameSpace(saveFolder & dName).Items
        Name fileFolder & "CallsByHour.xls" As fileFolder & "CBH-" & Format(Date, "yyyymmdd") & ".xls"
        Kill saveFolder & dName

    Next

End Sub

Answer 1

假设您在 Outlook 中编码，这将处理在 Outlook 中选择的项目，将附件保存到 C:\Temp 并将 zip 内容解压缩到 C:\Temp\unzipped

编辑（未经测试）- 添加了基于日期时间的子文件夹

Sub Tester()

    SaveZip Application.ActiveExplorer.Selection.Item(1)

End Sub


Public Sub SaveZip(itm As Outlook.MailItem)

    Const saveFolder = "C:\Temp\"

    Dim objAtt As Outlook.Attachment
    Dim oApp As Object
    Dim dName As Variant, unZipFolder

    If itm.Attachments.Count > 0 Then

        unZipFolder = saveFolder & "unzipped\" & " _
                      Format(Now,"yyyymmdd_hhmss")

        MkDir unZipFolder 

        For Each objAtt In itm.Attachments

            dName = objAtt.DisplayName

            objAtt.SaveAsFile saveFolder & dName

            Set oApp = CreateObject("Shell.Application")

            oApp.NameSpace(unZipFolder).CopyHere _
               oApp.NameSpace(saveFolder & dName).Items

        Next
    End If     'any attachments
End Sub

使用 Outlook 规则下载并解压缩压缩附件

Downloading and then extracting zipped attachments using an Outlook rule

zip

outlook

vba