如何覆盖从磁盘上的 zip 中提取的文件?

How to overwrite file extracted from zip on disk?

下面从一个.zip文件中提取一个.xls文件,然后用一个新的名字保存到指定的目录中。

Public Sub saveAttachmentZip(itm As Outlook.MailItem)
    
    Const saveFolder = "C:\Temp\"
    Const fileFolder = "C:\Report\"
    
    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:\Report\").CopyHere _
               oApp.NameSpace(saveFolder & dName).Items
               Name fileFolder & "Report.xls" As fileFolder & "NewReport.xls"
               Kill saveFolder & dName
    Next
    
End Sub

这只工作一次,然后由于文件已经存在而失败。有没有办法覆盖现有文件?

奖金信息

我还有以下功能,但对于没有压缩扩展名的电子邮件,它会做同样的事情,这会覆盖磁盘上的文件。

Public Sub saveAttach(itm As Outlook.MailItem)
    
    Const fileFolder = "C:\Report\"
    
    Dim objAtt As Outlook.Attachment
        
    For Each objAtt In itm.Attachments
        objAtt.SaveAsFile fileFolder & "\" & "OldReport.csv"
        Set objAtt = Nothing
    Next
    
End Sub

根据我的测试,将 CopyHere 更改为

oApp.NameSpace("C:\Report\").CopyHere _
       oApp.NameSpace(saveFolder & dName).Items, _
       4 + 16

应该这样做。

根据 the docs,标志 4 抑制进度对话框,标志 16 强制 "Yes to All" 响应。

在 Windows 的旧版本中(我记得),"Yes to All" 是 "overwrite" 响应,这似乎对我来说是正确的。

在 Windows 8.1 Pro 上的 Word 2013 VBA 中测试。我用静态文件名检查了这个,而不是 .Items 集合。