[巨集]打開 Outlook附加的圖檔

每當有朋友轉寄信件時 Cheesy

往往以附加檔案的方式附加圖檔 Sad

一個一個的打開真的好麻煩 Angry

又不想裝Outlook Helper等軟體 Roll Eyes

難道沒有別的方法可想了嗎? Sad

試試看這個VBA的巨集吧

說不定可以解決你的需求呢 Wink

使用方法

1.打開Outlook
2.工具-->安全性-->選到中
3.工具-->巨集-->錄製巨集
4.輸入OpenPicture並按下建立
5.點選編輯，接著會開啟VB編輯視窗
6.將以下的程式碼貼入（不含 Sub 及 End Sub這兩行）
7.存檔後離開
8.打開一份有圖檔的郵件
9.到工具-->自訂
10.左邊的類別欄中選"巨集"，再將右邊的指令欄的巨集物件拉到上方的工具列中

Sub OpenPicture()
On Error Resume Next

Dim oOL As Outlook.Application
Dim oSelection As Outlook.Selection

Set oOL = New Outlook.Application
Set oSelection = oOL.ActiveExplorer.Selection
Set fs = CreateObject("Scripting.FileSystemObject")

vPath = "c:\Attachments_Outlook\"
If Not fs.FolderExists(vPath) Then fs.CreateFolder vPath

vSubject = "Attachments from: ---"
vHTMLBody = "<HTML>"

For Each obj In oSelection
　vSubject = vSubject & """" & obj.Subject & """---"
　For Each Attachment In obj.Attachments
　　Attachment.SaveAsFile (vPath & Attachment.FileName)
　　vHTMLBody = vHTMLBody & "<FONT face=Arial size=3>" & _
　　　Attachment.FileName & "</Font>" & "<IMG alt="""" hspace=0 src=""" & _
　　　vPath & Attachment.FileName & " ""align=baseline border=0>"
　Next
Next

Set objMsg = oOL.CreateItem(0)
With objMsg
　.Subject = vSubject
　.HTMLBody = vHTMLBody & "</HTML>"
　.Display
　DoEvents
End With

For Each obj In oSelection
　For Each Attachment In obj.Attachments
　　fs.DeleteFile (vPath & Attachment.FileName)
　Next
Next

Set fs = Nothing
Set objMsg = Nothing
Set oSelection = Nothing
Set oOL = Nothing

End Sub

程式碼不是我寫的
如果大家覺得好用
就謝謝不知名的作者吧