使用 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

在不产生大量错误的情况下，我无法在现有代码中实现这一点（我敢肯定，由于我自己缺乏理解）

对此的任何意见将不胜感激

最终编辑

知道了，感谢蒂姆的所有帮助。下面将从收到的电子邮件中下载附件（始终命名相同）到 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

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

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