如何自动保存附件，覆盖？答案

【问题标题】：How to automatically save an attachment, with overwrite?如何自动保存附件，覆盖？
【发布时间】：2020-06-21 08:50:25
【问题描述】：

我正在尝试从 Outlook 电子邮件中提取 Excel 报告，并将其保存在我的 Documents 文件夹中名为“OLAttachments”的文件夹中。

我还需要它来覆盖前一天的文件。这些电子邮件附件每天都具有相同的名称。

这是我目前所拥有的。每次收到电子邮件时，它都会保存一个新文件，而我想覆盖现有文件。

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\fmustapha\Documents\Outlook Attachments"
For Each oAttachment In MItem.Attachments
    oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

【问题讨论】：

见Save attachment from an email in to a folder that changes every month。作为记录，您“编码”或“编写”VBA，而不是“个性化”它。
你想把它保存在今天的日期吗？
不，我只是想将它保存为通用文件名“新成员”，并让它用前一天的数据替换文件。所以每天它都会替换。这会是一个问题吗？它会一直提示您澄清是否要替换现有文件吗？因为如果是这样，我可以将其保存为“新成员 MM-DD-YYYY”
“我还需要它来覆盖前一天的文件，因为这些电子邮件附件每天都有相同的名称。”是通常的行为。 DisplayName 每次都一样吗？

标签： vba outlook

【解决方案1】：

我在我的服务器上执行此操作，我每晚都会收到一封附有 Excel 文件的电子邮件，该电子邮件会自动转发到我的服务器，此 Outlook 代码会在其中保存附件。请注意，其中有一个子句来确保文件来自我并确保它是 Excel 文件：

Private WithEvents olItems As Outlook.Items

Private Sub Application_Startup()
Dim objNS As Outlook.NameSpace
Set objNS = GetNamespace("MAPI")
Set olItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set objNS = Nothing
End Sub

Private Sub olItems_ItemAdd(ByVal Item As Object)
    Dim NewMail As Outlook.MailItem
    Dim Atts As Attachments
    Dim Att As Attachment
    Dim strPath As String
    Dim strName As String

    If Item.Class = olMail Then
       Set NewMail = Item
    End If
    strPath = "C:\Reporting Archive\Sales Files\"
    If NewMail.Sender = "Dan Donoghue" Then

       Set Atts = Item.Attachments

       If Atts.Count > 0 Then
          For Each Att In Atts
              If InStr(LCase(Att.FileName), ".xls") > 0 Then Att.SaveAsFile strPath & Att.FileName
          Next
       End If
    End If
End Sub

它进入 VBE 中的ThisOutlookSession，一旦你将其关闭并重新打开 Outlook，它就会工作。

要保存在顶部，我建议您先删除现有文件（您可以为此使用kill 命令，然后简单地保存新文件）。

你可以通过替换这个来做到这一点：

If InStr(LCase(Att.FileName), ".xls") > 0 Then Att.SaveAsFile strPath & Att.FileName

用这个：

If InStr(LCase(Att.FileName), ".xls") > 0 Then
    Kill strPath & Att.FileName
    Att.SaveAsFile strPath & Att.FileName
End If

在我的代码中

【讨论】：

【解决方案2】：

您可以设置一个规则，以您想要的任何频率触发此作业（您可能不希望该规则在几秒钟内运行，但更像是每天 1 次、夜间等）

Public Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)
Dim oAttachment As Outlook.Attachment
Dim sSaveFolder As String
sSaveFolder = "C:\Users\DT168\Documents\outlook-attachments\"
For Each oAttachment In MItem.Attachments
oAttachment.SaveAsFile sSaveFolder & oAttachment.DisplayName
Next
End Sub

https://www.extendoffice.com/documents/outlook/3747-outlook-auto-download-save-attachments-to-folder.html#a1

【讨论】：

【解决方案3】：

尝试使用Date function，它返回一个包含当前系统日期的变量（日期）。 MSDN

例子

oAttachment.SaveAsFile sSaveFolder & "New Members" & " " & Format(Date - 1, "MM-DD-YYYY")

【讨论】：

非常感谢！我真的更喜欢覆盖文件，但我绝对可以满足这种格式......我很感激！