質問: excel vbaで→pdf化→自動メール送信 現在excelvbaでプリンターに出力された納品書を毎日50社ぐらいの顧客に手動faxにて送っています。 通信費削減のために、ファイルをpdf化してemail送信出来るようにしたいと思っています。 添付するファイルがexcel bookのままであれば以下のコードで出来るのですが、pdf化するやり方が分かりません。 activeworkbook.sendmail recipients:="email@*****.co.jp", _ subject:="test" 10万円程度であれば、adobe acrobatなどのソフト購入してでも実現させたいと思っています。 又、ユーザーの操作はメーラーの「送信」ボタンをクリックする程度に留めたいです。 よきアドバイスよろしくお願いいたします。
回答: wordドキュメント → pdf への変換なら、以前vbのメーリングリストでコードを見たことがあり、それを元に作成した経験があります。(2003年の8月頃?) excelにもworkbook.printoutメソッドはあり、printtofile が引数で指定できますので、同じようなことはできるはずです。(未確認) 参考までに、word用のコードを単純化したものを抜粋します。 ※ 下記は、必要最小限の要素を単純化して示したものです。 このままでは汎用性もなく、使い物にはなりません。 ※ インデントは半角スペースに変換のこと。 '**************************************************************** '必要ライブラリ ' 'microsoft word 9.0 object library c:\program files\microsoft office\office\msword9.olb 'acrobat distiller c:\program files\adobe\acrobat 5.0\distillr\acrodist.exe '**************************************************************** ' 'エラーコードの定義 public const perrprinternotavailable as long = 2212 'プリンタが無効です。 sub makepdfsample(byref strprinter as string) 'wordドキュメントのpdf変換 'コードの一部分のみ抜粋。 dim objwrdapp as object ' word.application dim objwrddoc as object ' word.document dim objabdist as object ' acrodistxlib.pdfdistiller dim strdefaultprinter as string '「acrobat ・・・」以外のプリンタは使用させない。 if left$(strprinter, len("acrobat distiller")) <> "acrobat distiller" then err.raise perrprinternotavailable, _ , _ "このプリンタではpdfファイルは出力できません。" _ & vbcrlf & "adobe の acrobat distiller を選択してください。" end if set objwrdapp = createobject("word.application") 'new word.application set objabdist = createobject("pdfdistiller.pdfdistiller.1") 'new acrodistxlib.pdfdistiller '通常使用するプリンタの情報を退避。(処理の完了後、または実行時エラー発生時に元に戻す) strdefaultprinter = objwrdapp.activeprinter 'objwrdapp.activeprinter = "acrobat distiller on lpt1:" objwrdapp.activeprinter = strprinter set objwrddoc = objwrdapp.documents.open("c:\test.doc") objwrddoc.printout _ background:=false, _ printtofile:=true, _ outputfilename:="c:\test.ps" objabdist.filetopdf _ "c:\test.ps", _ "c:\test.pdf", _ vbnullstring objwrddoc.close false objwrdapp.activeprinter = strdefaultprinter objwrdapp.quit end sub option explicit '**************************************************************** '必要ライブラリ ' 'microsoft activex data objects 2.5 library '他のバージョンでの動作は未確認。(2.1での動作は×) 'microsoft cdo for exchange 2000 library '**************************************************************** '引数 ' 'strpath 添付ファイルのフルパス 'strsmtp smtpサーバー (例 : www.mail.hogehoge.com) 'strfromaddr 送信者アドレス (例 : hogehoge@hogehoge.com) 'strfromname 送信者名 (例 : ××株式会社 〇〇担当) 'strsubject 件名 (例 : 未承諾広告) 'straddr 送信先アドレス (例 : scott@tiger.com) 'strtoname 受信者名 (例 : △△株式会社 ◇◇様) 'strmailbody メール本文 'strccaddress ccアドレス 'strbccaddress bccアドレス '**************************************************************** '添付ファイル付きメールの自動送信。 public function sendmail( _ byref strpath as string, _ byref strsmtp as string, _ byref strfromaddr as string, _ byref strfromname as string, _ byref strsubject as string, _ byref straddr as string, _ byref strtoname as string, _ byref strccaddress as string, _ byref strbccaddress as string, _ byref strmailbody as string _ ) as boolean dim objmessage as cdo.message dim objconfiguration as cdo.configuration dim objfields as adodb.fields sendmail = false ' configurationオブジェクトを生成 set objconfiguration = new cdo.configuration ' filedsオブジェクトを生成 set objfields = objconfiguration.fields ' フィールド情報を設定 with objfields .item(cdosendusingmethod) = cdosendusingport .item(cdosmtpserver) = strsmtp ' フィールド情報を更新 .update end with ' messageオブジェクトを生成 set objmessage = new cdo.message ' メッセージ情報を設定 with objmessage set .configuration = objconfiguration .subject = strsubject .to = """" & strtoname & " 様"" <" & straddr & ">" if len(strccaddress) <> 0 then .cc = strccaddress if len(strbccaddress) <> 0 then .bcc = strbccaddress '複数アドレス指定の場合、変更の必要あり。 .from = """" & strfromname & """ <" & strfromaddr & ">" .textbody = strmailbody .addattachment strpath 'メールを送信 .send end with sendmail = true set objmessage = nothing end function