【VBAでOutlook操作２】

今回は2回目という事で、Excelファイルの特定のシートをPDFへ保存しメールへ添付するところまでをやりたいと思います。

前回までで出来ているコード

Public Sub SendMail()
    Dim FileName As String
    FileName = "ファイル名を指定".xlsx"
  
    Dim ol As Object
    Set ol = CreateObject("Outlook.Application")
    If ol Is Nothing Then Exit Sub
    
    With ol.CreateItem(0)
         .To = "test@example.com"  '送信先
        .CC = "cc@example.com"    'CCのアドレス
        .BCC = "bcc@example.com"  'BCCのアドレス
        .Subject = "Test Title"
        .Attachments.Add FileName  '添付ファイル
        .Display　                 '下書きを表示
        .Body = "本文を書く欄"
    End With
    
    Set ol = Nothing　'オブジェクト解放  
End Sub

よくわからなくなった方は、前回の記事を確認してみてください。

VBAでPDF保存

VBAから特定のシートをPDF保存することは難しくないです。
色々なサイトで紹介されていますが、一つ注意しなければならない事があります。
他の記事ではあまり、解説されていません。

なにを言いたいかというと、皆さんが今作っているOutlook自動操作プログラムを、特定のパソコンでしか使用しないことは無いと思います。

パソコンのフォルダ階層は、個人で使用するパソコン毎に異なっている部分が多いと思います。

それぞれのパソコンに合わせて、保存フォルダを書き直しても良いですが台数が多いと超大変！！です。

なので、次の様に保存場所を指定します。

PDFファイルの保存

    Dim WSH As Variant
    Set WSH = CreateObject("WScript.Shell")

    Path = WSH.SpecialFolders("Desktop")
  
    Set WSH = Nothing
  

とても便利で、使い勝手の良いオブジェクトなので、WScrit.Shellの使用方法は是非、マスターしてください。

PDF保存

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Path & "\Filename.pdf"

とても簡単ですね！！
特に注意するところはありません。
変数Pathへは先ほど取得したデスクトップのパスが入っています。
セパレータは取得できないので、セパレータ（\）とファイル名＋ .pdf
をファイル名として渡してやればよいです。

ここまでで完成したソースコード

皆さん、お疲れ様でした。
ここまでのソースコードをまとめて記載します。

Public Sub SendMail()
    Dim FileName As String
    FileName = "\" & "Filename".pdf" '保存ファイル名
  　
    'デスクトップへアクティブシートをPDF保存
    Dim WSH As Variant
    Set WSH = CreateObject("WScript.Shell")

    Dim WSH As Variant
    Set WSH = CreateObject("WScript.Shell")

    Path = WSH.SpecialFolders("Desktop")
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=Path & Filename

    Set WSH = Nothing　

    Dim ol As Object
    Set ol = CreateObject("Outlook.Application")
    If ol Is Nothing Then Exit Sub
    
    With ol.CreateItem(0)
         .To = "test@example.com"  '送信先
        .CC = "cc@example.com"    'CCのアドレス
        .BCC = "bcc@example.com"  'BCCのアドレス
        .Subject = "Test Title"
        .Attachments.Add Path & FileName  '添付ファイル(パスとファイル名を指定)
        .Display　                 '下書きを表示
        .Body = "本文を書く欄"
    End With
    
    Set ol = Nothing　'オブジェクト解放  
End Sub