讓outlook幫你另存[附件]到本地硬盤上吧!

jack5d

本是路過這OUTLOOK區的，看到一個貼子上有人問自動[另存附件]到本地硬盤上。以為這問題只要搜一下答案多的是。
誰知道問這問題的人更少。雖然本區精華貼集中營中也有好幾道是介紹這一方法，但好像都是散答的，沒有專題介紹。

基本上用ＯＵＴＬＯＯＫ的人我認為９０％是工作需要，我不相信一般平民會用ＯＵＴＬＯＯＫ來接收Ｅ－ＭＡＩＬ。
就我自己而言，工作上有需要跟老外溝通，但由於時差及話費不能時常用電話溝通。大家溝通都以Ｅ－ＭＡＩＬ來往。
由其是下訂單多數會有ＰＤＦ的附件，一些常客就每天都有訂單，大客戶一天就給你十封八封Ｅ－ＭＡＩＬ全是有附件的訂單。

為了解決每天收Ｅ－ＭＡＩＬ還要另存附件對查錯漏，我就去找［規則］上是否有能設定另存附件的呢？可惜，沒有！但有幸的是原來ＯＵＴＬＯＯＫ也有ＶＢＡ的，這下可好了。於是我就看了一些ＯＵＴＬＯＯＫ的方法及物件對象，後來自己寫了下邊的［巨集］。

Public Sub SaveAttachment(objMsg As Outlook.MailItem)
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i, k As String
Dim lngCount As Long
Dim strFile, NstrFile As String, strExt As String
Dim strFolderpath As String
Dim strSaveFile As String
Dim fs
   
On Error Resume Next
   
strFolderpath = "C:\Dropbox\HongKong_Office\NonOCR_PDF\"
Set fs = CreateObject("Scripting.FileSystemObject")
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
   
If lngCount > 0 Then
    For i = 1 To lngCount
   
        ' 取得附件檔名  *副檔名,可用來對附件來做進一步處理
        strFile = objAttachments.Item(i).FileName
        
        'k以時間序來重名副檔案名,以免重覆檔案名
        k = VBA.Year(Now) & Month(Now) & Day(Now) & Hour(Now) & Minute(Now) & Second(Now)
        
        '設定檔案名 *原檔名 + 儲存年月日時分秒 + 副檔案名
        NstrFile = fs.GetBaseName(strFile) & "(" & k & ")." & fs.GetExtensionName(strFile)
        
        ' 指定儲存路徑
        strSaveFile = strFolderpath & NstrFile
        
        ' 儲存附件
        objAttachments.Item(i).SaveAsFile strSaveFile
    Next i
End If
'在郵件主旨上加上"SAVED!"
objMsg.Subject = "SAVED!" + objMsg.Subject
objMsg.Save
End Sub

zjgwzj

很实用，但代码可以更简化一些

chicagogo

yes, good,
thx

6683529

感谢楼主的细心，但看见人家好像直接设置就可以了，希望能有人指点一下

qhz

哈哈，原来港台的“巨集”就是内地的“宏”呀。看得我一头雾水。
谢谢楼主！

bjhuige

找了很久了,谢谢

yunlaiqu0100

很好用，谢谢！

luckxdsxds123

找了好久，终于被我找到了， 感感谢谢楼主

ever7ess

谢谢楼主！～～

lmswy

好用！谢谢！