自动保存邮件附件至指定文件夹

最近有个需求，ERP系统会自动发很多csv附件到我邮箱，我需要把这些附件上传到FTP服务器，服务器会把这些csv的数据写到另外一个系统的数据库。

每次大概有30个邮件，每个邮件有一个附件，而且附件的名字都一样，是一个csv的文件，我每次需要手动的把附件另存为一个新名字存到本地，然后FTP上传。

每次大概要浪费我10分钟时间，而且毫无价值。

于是我就写了一个VBA的自动处理程序，几秒搞定。

如果你也有类似的需求，或者把附件再进行写入数据库，或者附件是Excel，需要整合到数据库，可以再在服务器开发一个自动处理机器人，设置每5分钟检测一下是否有新文件，如果有就写入数据库或添加到一个总Excel表格。这些VBA 或 C#都可以完美处理。

话说把大象装进冰箱分三个步骤：

第一步：

打开Outlook - Option - Trust Center - Truster Center Settings - Macro Settings - 勾选Enable all macros。

打开Outlook - Option - Trust Center - Truster Center Settings - Email Security - 勾选Allow script in shared folders 和 All script in public folders

重点：重启Outlook，我因为没重启outlook，浪费了很多时间。

第二步：

编写宏程序，按下Alt+F11，创建新项目，把程序copy进去，文件夹地址改一下

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

Public Sub SaveAttach(MyItem As Outlook.MailItem)

    SaveAttachment MyItem, "C:\Data\MailAttached\"

    'MsgBox "附件已保存"

End Sub

Private Sub SaveAttachment(ByVal Item As Outlook.MailItem, path, Optional condition = "*")

    Dim olAtt As Outlook.Attachment

    Dim i As Integer

    Dim dateFormat

    dateFormat = Format(Now, "yyyy-mm-dd hh-mm-ss")

    If Item.Attachments.Count > 0 Then

        For i = 1 To Item.Attachments.Count

            Set olAtt = Item.Attachments(i)

            If olAtt.FileName Like condition Then

                olAtt.SaveAsFile path & dateFormat & "_" & olAtt.FileName

            End If

        Next

    End If

    Set olAtt = Nothing

    Sleep 1000

End Sub

如下图：保存

解释一下，因为我每个附件名字都相同，用时间重命名，只能到秒这个级别，所以我每次处理都Sleep 1秒，否则有可能会覆盖掉上一个文件。

第三步：

制作运行规则，这一步比较简单，只放一张图片，仔细看每个设定