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 < / p>

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

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规则

1 个答案: