*這裡所說的 "Outlook" 是指 "Microsoft Office (我用的是2003版)" 裡的 Outlook，不是 Outlook Express。Outlook Express 不支援 VBA。

有位網友在知識+提出 "將Outlook的email附加檔案轉存至資料夾的VBA程式" 的請求，他說，每天都會收到各業務單位寄給他的 Excel檔案，所以每天都要將很多 Email 的附件檔一一地「另存新檔」。能不能寫個 Outlook 的 VBA 程式，把這些附加檔案一口氣全部轉存到指定的資料夾呢?

對於 Outlook 的 VBA，我的撰寫經驗很少，一方面是需求不多，另一方面是因它沒有錄製巨集的功能，參考資訊也比 Excel 少。好奇心驅使之下，我研究了一下，嘗試寫了一個 subroutine，測試完成之後貼進解答中。可惜的是，那個問題後來淪為 "網友票選"，最後竟然被系統移除了 (可能是因為只有我和提問者投票)。

底下就是我寫的SaveAttachments()程式碼, 會將Outlook收件匣所有附件檔一一地另存到 "D:\來信的附件檔" (見 TargetFolder 變數值的設定)：

Sub SaveAttachments()
'會將收件匣所有附件檔另存

Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myAttachments As Outlook.Attachments
Dim myItems As Outlook.Items
Dim TargetFolder As String, SFName As String, NSFName As String
Dim i As Integer

TargetFolder = "D:\來信的附件檔"       '檔案將要存入此處

Set fs = CreateObject("Scripting.FileSystemObject")
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
    'myFolder 代表 "收件匣 Inbox"
Set myItems = myFolder.Items
    'myItems 代表 "收件匣" 中所有信件 (的集合)

For Each mail In myItems   '檢查每一封信
    Set myAttachments = mail.Attachments
        'myAttachments 代表這封信件裡所有附件檔 (的集合)
    For Each att In myAttachments
        SFName = TargetFolder & "\" & att.FileName
        If fs.FileExists(SFName) Then '若檔案已存在, 就加上 (數字)
            i = 0
            Do
                NSFName = TargetFolder & "\" & fs.GetBaseName(SFName) _
                      & "(" & i & ")." & fs.GetExtensionName(SFName)
                i = i + 1
            Loop While fs.FileExists(NSFName)
            att.SaveAsFile NSFName '用加了數字的檔名儲存
        Else
            att.SaveAsFile SFName  ''若檔案不存在, 就用原來的檔名儲存
        End If
    Next att
Next mail

End Sub

這個程式的重點可分為兩部份:

(一) 由 MAPI Namespace 存取得收件匣裡每封信的附件檔:

首先請注意程式開始 Dim 宣告中用到的 Outlook.NameSpace、Outlook.MAPIFolder、Outlook.Attachments、Outlook.Items 物件資料型別。看程式碼裡面，的註解就可以知道，這些型別的用途。

GetDefaultFolder(olFolderInbox) 就是取得 "收件匣"，GetDefaultFolder() 也可以用來存取 Outlook 裡其他預設資料夾。GetDefaultFolder(OlDefaultFolders) 引數如下:

olFolderCalendar         :行事曆
olFolderContacts         :連絡人
olFolderDeletedItems  :刪除的郵件
olFolderDrafts             :草稿
olFolderInbox             :收件匣
olFolderJournal           :日誌
olFolderNotes              :記事
olFolderOutbox           :寄件匣
olFolderSentMail         :寄件備份
olFolderTasks              :工作
olPublicFoldersAllPublicFolders :所有的公用資料夾
olFolderJunk               :垃圾郵件

(二) 附件檔儲存時如何避免檔名重複?

不同封 email 可能會有相同檔名的附件，所以要把附件檔全部存到一個資料夾，每個檔案存檔前都需用FileExists()檢查資料夾裡是否已有同名的檔案。若已有同名的檔案，就要換個檔名。我用的方法是，把 "檔名.副檔名" 拆開，在檔名後面加數字，再合起來變成  "檔名數字.副檔名"。而因為可能有兩個以上同名的檔案，所以我用一個 Do 迴圈把數字累加，一直到FileExists()檢查資料夾裡沒有同名的檔案為止。

※想要使用此程式卻不知如何在 Outlook 裡使用 VBA 的朋友，請留言或寄 email 給我。