Outlook VBA覆盖磁盘上的现有文件

我有以下代码，当前从.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

我应该这样做

根据，flag

4

抑制进度对话框，flag

16

强制“对所有人都是”响应

在旧版本的Windows中（我记得），“Yes to All”是“overwrite”响应，这对我来说似乎是正确的

---

在Windows 8.1 Pro上的Word 2013 VBA中测试。我用静态文件名检查了这个问题，而不是用

.Items

集合。

我仍然得到一个文件已经存在的错误。似乎它甚至没有达到Windows要求覆盖该文件的程度，而是因为该文件已经存在而在代码中失败。我偏离了你的思路，注释掉了重命名该文件的部分，然后删除了原始文件。这将正确覆盖文件，因此我可以从那里继续。谢谢你确定这段代码会运行吗？应用程序没有名为Namespace的属性或函数。GetNamespace函数只允许“MAPI”作为其参数。没有Outlook对象具有CopyHere方法。@DmitryStreblechenko正如我所说，我在Word中进行了测试，但没有Outlook，所以我不能与您争辩：）。

Shell.Application

对象来自

Microsoft Shell控件和自动化

TLB-在工具中添加它|参考，您应该能够在

Shell32

库中看到

文件夹.CopyHere

。然后，OP在Outlook对象模型中执行此操作，它与Word对象模型完全没有共同之处。