Question

目前我有一个电子邮件进来，我的vba代码会将文件保存到文件夹，但是由于这个代码已经生成，他们现在将文件发送给我一个zip文件。这当然会破坏代码，我必须在非zip文件中重新发送它才能使其正常工作。以下是我目前使用的示例：

如果左（objItem.Subject，28）=＆＃34; xxxxx报告工具箱＆＃34;然后

    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"

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

1 个答案: