自动从特定收件箱下载电子邮件附件、检测文件类型、重命名和删除电子邮件

时间:2021-04-22 14:32:13

标签: vba outlook

这个问题是在花了几个小时试图让主要部分工作(通过宏下载附件)之后出现的,到目前为止一直失败。

这是我正在尝试构建的内容:

(1) 一个脚本,它自动从一个特定 Outlook 收件箱(这不是我的主要 Outlook 电子邮件,而是链接到我的 Outlook 配置文件(?))中下载附件。 特定发件人地址。

(2) 它必须将附件下载到特定驱动器。

(3) 根据邮件日期和附件名称重命名文件。

(4) 删除附件后,必须删除邮件。

在下面的示例中,我区分了带有“Mechanic”、“Job”的文件名和没有该短语的文件名,但实际上不仅仅是这些区别。总而言之,我可能需要为 4 或 5 个案例编写代码,但我认为我有足够的能力至少从 3 个案例中进行推断。而且我并不喜欢在特定类型的代码中完成这项工作,但是VBA 似乎是 Outlook 宏最明显的选择。

这是我到目前为止所拥有的并且我没有任何生命迹象(我什至不相信我已经成功地将它链接到正确的收件箱。脚本不起作用,但如果它起作用了,我认为它会查看我的主要收件箱):

Sub SaveAttachments()

Dim olApp           As Object

Dim olNS            As Object

Dim olFolder        As Object

Dim olItems         As Object

Dim olItem          As Object

Dim olAtt           As Object

Dim sSaveToFolder   As String

Dim sReceivedTime   As String



sSaveToFolder = "[GENERIC LOCATION]" 



Set olApp = CreateObject("Outlook.Application")

Set olNS = olApp.GetNamespace("MAPI")

Set olFolder = olNS.Folders("Outlook").Folders("Inbox").Folders("MyFolder") 

Set olItems = olFolder.Items



For Each olItem In olItems

    Set sReceivedTime = Format(olItem.ReceivedTime, "dd mm yyyy")

    If olItem.Attachments.Count > 0 Then

        For Each olAtt In olItem.Attachments

            If olAtt.DisplayName = "*Mechanic*" Then

                 olAtt.SaveAsFile sSaveToFolder & "Mechanic\" & sReceivedTime & "-" & olAtt.FileName

                 olItem.Save

            End If

            If olAtt.DisplayName = "*Job*" Then

                 olAtt.SaveAsFile sSaveToFolder & "Job\" & sReceivedTime & "-" & olAtt.FileName

                 olItem.Save

            End If

        Next olAtt

    End If

    Set sReceivedTime = Nothing

Next olItem



Set olApp = Nothing

Set olNS = Nothing

Set olFolder = Nothing

Set olItems = Nothing

Set olItem = Nothing

Set olAtt = Nothing

End Sub

0 个答案:

没有答案