えーっと、マクロを書く場所(?)は
www.lisz-works.com
こちらが詳しいのでご参照ください。
えーっと、選択したメールの添付ファイル(エクセル、ワード、PDF)を印刷するマクロってのは
Print Attachments Automatically - VBOfficeの下のほうにある。
このままだとATTACHMENT_DIRECTORYが空なのでCドライブに「Attachments」ってフォルダ作って置く(私はこのディレクトリがないと印刷できなかったが、なくても印刷できるっていう人もいた。試してくれ)
当方Outlook2010なり。
んで、コピったコードのままじゃ動かんかったので下記のように修正
意味わかってないので突っ込み歓迎(;´Д`)
Private Sub PrintAttachments(oMail As Outlook.MailItem) On Error Resume Next Dim colAtts As Outlook.Attachments Dim oAtt As Outlook.Attachment Dim sFile As String Dim sDirectory As String Dim sFileType As String 'D:\->C:\ sDirectory = "C:¥Attachments¥" Set colAtts = oMail.Attachments If colAtts.Count Then For Each oAtt In colAtts sFileType = LCase$(Right$(oAtt.FileName, 4)) Select Case sFileType Case ".xls", ".doc", ".pdf" 'ATTACHMENT_DIRECTORY-> sDirectory sFile = sDirectory & oAtt.FileName oAtt.SaveAsFile sFile ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0 End Select Next End If End Sub
んで、このままだと
- 新しい拡張子に対応してない(xlsxとかxlsm)
- リンクとか含むエクセルだといちいちアラートが出る(保存しますか?ってやつ)
そこで、印刷するのはエクセルだけに特化することにする。
Private Sub PrintAttachments(oMail As Outlook.MailItem) On Error Resume Next Dim colAtts As Outlook.Attachments Dim oAtt As Outlook.Attachment Dim sFile As String Dim sDirectory As String Dim sFileType As String 'D:\->C:\ sDirectory = "C:\Attachments\" Set colAtts = oMail.Attachments If colAtts.Count Then For Each oAtt In colAtts sFileType = LCase$(Right$(oAtt.FileName, 4)) Select Case sFileType Case ".xls", "xlsx", "xlsm" 'ATTACHMENT_DIRECTORY->sDirectory sFile = sDirectory & oAtt.FileName oAtt.SaveAsFile sFile 'ShellExecute 0, "print", sFile, vbNullString, vbNullString, 0 'Excelでファイルを開いて印刷して保存しないで閉じる Set ExAp = CreateObject("Excel.Application") ExAp.displayalert = False Set book = ExAp.Workbooks.Open(sFile) book.activesheet.PrintOut book.Close (False) book = Nothing ExAp.Quit ExAp = Nothing End Select Next End If End Sub
こんな感じで動いた(と思う)