PowerPointのVBAからスライドに埋め込んだOLEオブジェクトをファイルとして利用する

###はじめまして###
Qiita初投稿です。
元は組み込み系ソフトウェア開発やってましたが、最近書くコードと言えば専らPythonやVBAです。今は装置メーカーのテクニカルサポートエンジニアなので、そんな感じです。
最近、PowerPointからSharePoint上のExcelを読み込んでスライドに表示し、その内容をメール送信する為のVBAマクロを書けと言われました。実際はもっとふゎっとしたリクエストでしたけど。
取り敢えず、自PCで作ったテスト環境では問題なかったのですが、いざ本番環境に近い環境で試してみたらSharePointに置いたメールテンプレートを直接読み込めない事が判明しました。メールの送信先とかの変更が簡単になるようにOutlookのメールテンプレート(*.oftファイル)はSharePointに置けたらよかったのですけど、Outlookの[`CreateItemFromTemplate`](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.application.createitemfromtemplate "Application.CreateItemFromTemplate method (Outlook)")メソッドがURLは受け付けてくれないようです。
OLEオブジェクトとしてPowerPointに埋め込んだら行けそうかな？と試して取り敢えず動いてそうなのでシェアしてみます。何方かの参考になれば幸いです。

###PowerPointスライドのイメージ###
↓のようなスライドをPowerPointで作成して、VBAはPowerPointで実装しました。Outlookメールテンプレート(*.oft)は実際には見えない場所に貼り付けました。
<img width="640" src="https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/264719/f8fa2bd6-b6af-95e4-6cac-7dea9826dc39.png">

###VBAコード###
貼り付けてあるOLEオブジェクトを[`CreateItemFromTemplate`](https://docs.microsoft.com/ja-jp/office/vba/api/outlook.application.createitemfromtemplate "Application.CreateItemFromTemplate method (Outlook)")で使うには、一旦ファイルとして保存しないといけないんですけど、少し調べると[`OLEObject.Copy`](https://docs.microsoft.com/ja-jp/office/vba/api/excel.oleobject.copy "OLEObject method (Excel)")や[`OLEObject.Duplicate`](https://docs.microsoft.com/ja-jp/office/vba/api/excel.oleobject.duplicate, "Duplicate method (Excel)")を実行すると一時ファイルが作られることが分かりました。[こちら](https://www.mrexcel.com/board/threads/ole-objects-path-file-location.941857/ "OLE Objects Path File location?")にあるコードでは毎回一時ファイルが作られる[`OLEObject.Duplicate`](https://docs.microsoft.com/ja-jp/office/vba/api/excel.oleobject.duplicate, "Duplicate method (Excel)")を使用し、且つ5秒以内に作成されたものが対象の一時ファイルだろうと判断しているようです。今回の場合はファイルを元に作られたOLEオブジェクトで、一時ファイル名は元のファイル名と同じか、それに番号が振られたものになるようでした。なので下記コードでは[`OLEObject.Copy`](https://docs.microsoft.com/ja-jp/office/vba/api/excel.oleobject.copy "OLEObject method (Excel)")を使い、ファイル名が指定パターンにマッチする最新の一時ファイルを選択するようになっています。基本的に一時ファイルはPowerPointアプリが終了すると削除されるようです(たまに消されないまま残ってますが)。また、OLEオブジェクトを更新すると作られる一時ファイルも更新されるようです。
下記はPowerPointスライドのExcelテーブルをコピーして、メールテンプレートの指定位置に挿入する部分のコードで、冒頭に書いたリクエストのSharePointのExcelからデータを読み込む部分は含まれていません。

#####定数と`Main`ルーチン#####
各定数についてはコード内のコメントを参照ください ^^;
`Main`ルーチンでは、スライド内のExcelワークシートにあるOLEObjectに対し[`OLEObject.Copy`](https://docs.microsoft.com/ja-jp/office/vba/api/excel.oleobject.copy "OLEObject method (Excel)")を実行して一時ファイルが存在する状態に。`GetLatestTempFile`をコールして該当する一時ファイルの中で最新のものを見つけ、`ComposeEmail`に渡すという流れです。

```vb
' -*- coding: utf-8 -*-
Option Explicit

Const SlideToSend    = 1                    ' The 1st slide
Const ShapeName      = "ExcelTable"         ' Shape name for the Excel Spreadsheet inserted in the slide
Const MySheet        = "SheetToSend"        ' Excel Worksheet name to be sent
Const MyRange        = "A2:E6"              ' The range to be copied and inserted to the email
Const OLEObjectName  = "EmailTemplateOft"   ' Object name of the Outlook email template file inserted to the Excel worksheet
Const OftFilePattern = "EmailTemplate*.oft" ' Temporary file name pattern for the template file
'The original file name was "EmailTemplate.oft", but the temporary file name can be like "EmailTemplate (2).oft".
Const SubjDateRepStr = "__DATE__"           ' String to be replaced with the actual date
Const SubjDateFormat = "YYYY-MM-DD"         ' Date format to be used
Const OftInsertPos   = 93                   ' Insert position in the template as number of characters

Sub Main()
   Dim theSlide As Object
   Dim oftPath As String, oftObj As Object, excelRange As Object

   Set theSlide = ActivePresentation.Slides(SlideToSend)
   With theSlide.Shapes(ShapeName).OLEFormat.Object.Worksheets(MySheet)
      Set oftObj = .OLEObjects(OLEObjectName)
      If Not oftObj Is Nothing Then
         oftObj.Copy ' this will create a temporary oft file
         oftPath = GetLatestTempFile(OftFilePattern)
         If oftPath <> "" Then
            Set excelRange = .Range(MyRange)
            ComposeEmail excelRange, oftPath
         End If
      End If
   End With
End Sub
```
#####`ComposeEmail`#####
Excelの`Range`オブジェクトとOutlookメールテンプレートのパスを受け取り、テンプレートのメールサブジェクト内の日付を更新し、受け取ったExcelの`Range`オブジェクトで示される範囲のセルをメール本文の指定位置に挿入した後、メールのドラフトを表示します。
テンプレートのメールサブジェクトに現在の日付で置き換えられる為の`SubjDateRepStr`定数で示される文字列が含まれる事を前提としています。

```vb
Sub ComposeEmail(aExcelRange As Variant, aMailTemplate As String)
   Dim objOL, objMail As Object
   Dim objEdit As Object

   Set objOL = CreateObject("Outlook.Application")
   Set objMail = objOL.CreateItemFromTemplate(aMailTemplate)
   With objMail
      .Subject = Replace(.Subject, SubjDateRepStr, Format(Date, SubjDateFormat))
      Set objEdit = .GetInspector().WordEditor
      ' copy & paste table into the mail body
      aExcelRange.Copy
      objEdit.Characters(OftInsertPos).Paste
      .Display
   End With
End Sub

```
#####`GetLatstTempFile`と`GetLatestFile`#####
`GetLatestTempFile`は、ファイル名パターンを受け取り、一時ファイル用フォルダの[`Folder`](https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/folder-object "Folder object")オブジェクトを取得し、そのフォルダとサブフォルダについて`GetLatestFile`をコールし受け取ったファイル名パターンにマッチする最新の一時ファイルを探し、そのパスを返します。見つからなかった場合は空文字列を返します。
今回のケースでは一時ファイルは下記の様に`%TMP%`で示される一時ファイル用フォルダのひとつ下のサブフォルダに作成されていました。(下記'`x`'の部分は実際はGUIDの16進表記ぽいです)

`%TMP%\{xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx}\EmailTemplate.oft`

`GetLatestFile`は[`Folder`](https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/folder-object "Folder object")オブジェクトとファイル名パターンを受け取り、[`Folder`](https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/folder-object "Folder object")オブジェクトで示されるフォルダ内でファイル名パターンにマッチする最新のファイルを[`File`](https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/file-object "File object")オブジェクトとして返します。

```vb
' Finds the latest temporary file matching given file name pattern, then returns its path as String
Function GetLatestTempFile(aFilePattern As String) As String
   Dim fsoObj As Object
   Dim folderObj As Object, subfolderObj As Object
   Dim fileObj As Object, latestFileObj As Object, timestamp As Date

   Set latestFileObj = Nothing
   timestamp = vbEmpty ' =0, same as #1899/12/30 0:00:00#
   Set fsoObj = CreateObject("Scripting.FileSystemObject")
   Set folderObj = fsoObj.GetFolder(fsoObj.GetSpecialFolder(2)) ' 2: Temporary folder (should be same as %TMP%)
   For Each subfolderObj In folderObj.SubFolders
      Set fileObj = GetLatestFile(subfolderObj, aFilePattern)
      If Not fileObj Is Nothing Then
         If fileObj.DateCreated > timestamp Then
            Set latestFileObj = fileObj
            timestamp = fileObj.DateCreated
         End If
      End If
   Next subfolderObj
   Set fileObj = GetLatestFile(folderObj, aFilePattern)
   If Not fileObj Is Nothing Then
      If fileObj.DateCreated > timestamp Then
         Set latestFileObj = fileObj
      End If
   End If
   If Not latestFileObj Is Nothing Then
      GetLatestTempFile = latestFileObj.Path
   Else
      GetLatestTempFile = ""
   End If
End Function

' Finds the latest file matching given file name pattern in given folder, then returns it as File object
Function GetLatestFile(aFolder As Object, aFilePattern As String) As Object
   Dim fileObj As Object, foundFileObj As Object, timestamp As Date

   Set foundFileObj = Nothing
   timestamp = vbEmpty ' =0, same as #1899/12/30 0:00:00#
   For Each fileObj In aFolder.Files
      If fileObj.Name Like aFilePattern Then
         If fileObj.DateCreated > timestamp Then
            Set foundFileObj = fileObj
            timestamp = fileObj.DateCreated
         End If
      End If
   Next fileObj
   Set GetLatestFile = foundFileObj
End Function
```

因みに上記コード中、最初下記のように書いてましたが、エラーしてしまいました。
VBAは、このようなIf文の左式が偽でも右式も評価するのでしょうか。

```vb
   If Not fileObj Is Nothing And fileObj.DateCreated > timestamp Then
```

###メールイメージ###
メールテンプレートの内容によりますが、元のスライドにあったテーブルが下記の様にメールボディにインサートされます。
![mail.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/264719/b6d3934f-8f9f-2043-a369-c75959708aaf.png)

以上です。
サンプルコードはエラー処理などが十分ではないと思われますが、ご了承ください。
VBAはいつまでたっても初心者な感じですが、間違いやおかしな点などあれば指摘いただけると嬉しいです。