如何在Outlook中解压缩附件并将其保存到使用VBA的文件夹中

Question

目前，我收到一封电子邮件，我的vba代码会将文件保存到文件夹，但是自从创建此代码以来，他们现在将文件以zip文件发送给我。 这当然会破坏代码，我必须在非zip文件中重新发送它才能使其正常工作。 这是我当前正在使用的示例：

如果Left（objItem.Subject，28）=“ xxxxx report Toolbox”，则

    For Each Atmt In objItem.Attachments
            FileName = "O:\Automated Reports\toolbox.xlsx"
            Atmt.SaveAsFile FileName
            modify_file
        Debug.Print "success CSAT file"
        Open "O:\Automated Reports\toolboxDate.JW" For Output As #1
        Write #1, Right(objItem.Subject, 5)
        Close #1
    Next Atmt

End If

正如我之前所说的，此代码可以在不保存.zip文件时仅保存文件就可以了。 我需要它来解压缩文件并将其保存到O：驱动器。 我试图使用一些shell.application对象，但是我没有完全使用它。 感谢您的提前帮助

Answer 1

'Create new blank zip.
Set Ag=Wscript.Arguments
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.OpenTextFile(Ag(0), 8, vbtrue)
BlankZip = "PK" & Chr(5) & Chr(6)
For x = 0 to 17
    BlankZip = BlankZip & Chr(0)
Next
ts.Write BlankZip

'Unzip
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")

Set SrcFldr=objShell.NameSpace(Ag(1))
Set DestFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"

'Zip
Set objShell = CreateObject("Shell.Application")
Set Ag=Wscript.Arguments
set WshShell = WScript.CreateObject("WScript.Shell")

Set DestFldr=objShell.NameSpace(Ag(1))
Set SrcFldr=objShell.NameSpace(Ag(0))
Set FldrItems=SrcFldr.Items
DestFldr.CopyHere FldrItems, &H214
Msgbox "Finished"