マクロ受信したHTMLメールから予定表を作成する OutlookVBA GetInspector().WordEditorを使いコピペ処理を行ってみた

受信したHTMLメールの本文から予定表を作成する。
メールの返信みたいに、
予定表の作成画面にコピーする。

そんな処理を行ってみたいと思います。
youtu.be
https://youtu.be/sR1IMMXZl-k
目次
00:00 やりたいこと・実行結果
03:21 1.1 ActiveExplorer.Selection
04:37 TypeNameで選択アイテムをチェックする
05:53 1.2 選択されたメールアイテムに対して .GetInspector().WordEditor で処理する
06:56 1.3 予定側の処理 Outlook.AppointmentItem
08:08 1.4 本文を.BodyFormat = olFormatHTML で HTML形式にする
09:04 1.5 同じく GetInspector().WordEditor で処理
10:13 1.6 元のメールファイルを閉じる予定は開きっぱなし
12:42 再度テスト実行を流す

#OutlookVBA #WordEditor
GetInspector().WordEditor を使用したサンプル再生リスト
https://youtube.com/playlist?list=PL8vZhsyiiFhvljaFA69MFTaI9BJN43TTB
↑他のGetInspector().WordEditorを使用したソースコード・動画も参考となれば幸いです。

キッカケは、知恵袋の質問で、
detail.chiebukuro.yahoo.co.jp
＞Outlookのマクロで、
＞予定表の本文に他のメールの本文を、
＞HTML形式でコピーする方法は無いでしょうか
＞
＞テキスト形式ならできるのですが、HTML形式だとやれませんでした。

と
あったので、
チャレンジしてみました。

1.簡単なコードの説明

1.1 ActiveExplorer.Selection
ActiveExplorer.Selection
で
選択アイテムがわかるので、

Selection.Count で選択されているかチェック

'選択されているアイテムをコピー複数選択でも１つしか処理しない
Dim oSelectItem As Object
Set oSelectItem = ActiveExplorer.Selection.Item(1) '選択されているItemを代入
で
選択アイテムを一つ入れ、

追加で、それが
"MailItem"か？を TypeName(oSelectItem) で確認

1.2 選択されたメールアイテムに対して .GetInspector().WordEditor で処理する

上で、簡単なチェックを通過したので、
GetInspector().WordEditor
で、Wordの世界、ドキュメントの処理に入る。

Dim objDOC As Object
Set objDOC = oSelectItem.GetInspector().WordEditor
'↑.WordEditorであとは、Wordの世界っぽく処理
'コピー元の Mail側
objDOC.Range.Copy '単純に全範囲をコピー

単純に、全コピーしました。

1.3 予定側の処理 Outlook.AppointmentItem

Dim aITEM As Outlook.AppointmentItem '予定、アポ
で、
変数作り
※それにしても、継ぎはぎだらけで、変数名が統一してないよね、
　いつも、コードが読みにくくって・・・

'CreateItemで予定の作成
Set aITEM = CreateItem(olAppointmentItem) 'olAppointmentItem=1 1予定・アポを指定
aITEM.Display '編集画面表示

'データのセット
aITEM.Subject = "HTMLメールから本文作成テスト" '…件名
'…場所
aITEM.Start = DateAdd("d", 1, Date) '…開始テストで明日から
aITEM.End = DateAdd("d", 3, Date) '…終了日時テストで三日後

1.4 本文を.BodyFormat = olFormatHTML で HTML形式にする

'本文は、コピー、貼り付け処理にする
'aITEM.Body = "テキストならこれで？" '…本文が HTMLなので
aITEM.BodyFormat = olFormatHTML 'まず、本文のフォーマットをHTMLへ

1.5 同じく GetInspector().WordEditor で処理

同じく(ってか、ここに貼り付けたいので、編集をWordEditor起動)

Dim objApoDOC As Object '予定表側のドキュメントもWordEditor編集
Set objApoDOC = aITEM.GetInspector().WordEditor
'↑.WordEditorであとは、Wordの世界っぽく処理

'コピー先の予定表アポ側
'objApoDOC.Paragraphs.Add 'この二行はいらないかも
'objApoDOC.Paragraphs(1).Range.Select '段落の追加とセレクトはなくても？
objApoDOC.Range.Paste
DoEvents

おっと、なんだよ、
Wordのエディターにして、
objApoDOC.Range.Paste
で、貼りつけただけかよ・・・

1.6 元のメールファイルを閉じる予定は開きっぱなし

'↑これで複製されるので、コピー元は.Closeで退場する
'んっ？もっと前で閉じてもいいのか？コピーはクリップボードに行くので
oSelectItem.Close olDiscard 'olDiscard:1 変更内容を破棄そもそもコピー元だしね

用済みの oSelectItem メールのオブジェクトをクローズして閉じます。

予定表の方は、開きっぱなしで、
ユーザが変更を加えて、
予定を作成します。

2.完成したソースコード

解説動画と合わせて見てください。

Option Explicit

Sub tset20230606_予定表へメール本文をコピーするHTML形式()

    If Application.ActiveExplorer.Selection.Count <> 1 Then
        MsgBox "メールアイテムを一つ選択してください", vbExclamation
        Exit Sub
    End If

    '選択されているアイテムをコピー 複数選択でも１つしか処理しない
    Dim oSelectItem As Object
    Set oSelectItem = ActiveExplorer.Selection.Item(1) '選択されているItemを代入
    
    If TypeName(oSelectItem) <> "MailItem" Then '念のためチェックいらないかな
        MsgBox "MailItem メールを一つ選択してください", vbExclamation
        Exit Sub
    End If
    
    oSelectItem.Display '表示してからコピーしないとエラー？なんだろう？
    DoEvents  'これないと、エラー
    
    Dim objDOC As Object
    Set objDOC = oSelectItem.GetInspector().WordEditor
    '↑.WordEditorであとは、Wordの世界っぽく処理
    'コピー元 の Mail側
    objDOC.Range.Copy   '単純に全範囲をコピー
    
    '予定側の処理
    Dim aITEM As Outlook.AppointmentItem '予定、アポ
    
    'CreateItemで予定の作成
    Set aITEM = CreateItem(olAppointmentItem)   'olAppointmentItem=1 1予定・アポを指定
    aITEM.Display   '編集画面表示

    'データのセット
    aITEM.Subject = "HTMLメールから本文作成テスト"  '…件名
                                '…場所
    aITEM.Start = DateAdd("d", 1, Date)  '…開始 テストで明日から
    aITEM.End = DateAdd("d", 3, Date)    '…終了日時 テストで三日後
    
    '本文は、コピー、貼り付け処理にする
    'aITEM.Body = "テキストならこれで？"    '…本文 が HTMLなので
    aITEM.BodyFormat = olFormatHTML  'まず、本文のフォーマットをHTMLへ
    
    Dim objApoDOC As Object  '予定表側のドキュメントもWordEditor編集
    Set objApoDOC = aITEM.GetInspector().WordEditor
    '↑.WordEditorであとは、Wordの世界っぽく処理

    'コピー先の予定表 アポ側
    'objApoDOC.Paragraphs.Add              'この二行はいらないかも
    'objApoDOC.Paragraphs(1).Range.Select  '段落の追加とセレクトはなくても？
    objApoDOC.Range.Paste
    DoEvents
    
    '↑これで複製されるので、コピー元は.Closeで退場する
    'んっ？もっと前で閉じてもいいのか？コピーはクリップボードに行くので
    oSelectItem.Close olDiscard  'olDiscard:1 変更内容を破棄 そもそもコピー元だしね
    
    MsgBox "処理終了、内容確認後、登録してください"

End Sub

3.終わりの挨拶

以上、単純に全体コピーして貼り付けただけでした。
コードをアレンジして、使ってみてください。

三流君 ken3のmemo置き場

三流プログラマーのメモ書きです。主にVBAやWindowsの話題が多いです

マクロ受信したHTMLメールから予定表を作成する OutlookVBA GetInspector().WordEditorを使いコピペ処理を行ってみた

フッター:最後にKen3Videoの動画一覧を紹介します