自動儲存郵件附件至指定檔案夾

最近有個需求，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秒，否則有可能會覆寫掉上一個檔案。

第三步：制作運作規則，這一步比較簡單，隻放一張圖檔，仔細看每個設定