我正在尝试从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
我在服务器上执行此操作,每晚我都会收到一封电子邮件,其中附有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
一旦将其关闭并重新打开Outlook,它将进入VBE中的ThisOutlookSession
,它将起作用。
要保存在顶部,我建议您首先删除现有文件(可以使用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
用我的代码
尝试使用Date function,它返回包含当前系统日期的变量(日期)。 MSDN
示例
oAttachment.SaveAsFile sSaveFolder & "New Members" & " " & Format(Date - 1, "MM-DD-YYYY")
您可以设置一个规则,以所需的任何频率触发此作业(您可能不希望该规则在几秒钟内运行,而更像是每天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