三流君 ken3のmemo置き場

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

挨拶・自己紹介:
失敗続きのAB型の変わり者 :三流プログラマー Ken3です
フリーのエンジニア・個人事業主です・・と書くと聞こえはイイが(それとなくカッコよく聞こえるが)、 現在は小さな案件の受注請負 と 短期派遣 で 日々つつましく?ほそぼそと暮らしてます。

よく検索されるキーワード: [質問回答XXXXさんへ] [CreateObject] [VBA] [JRA競馬オッズ]

Outlook VBA 下書きに保存したメールを元に書式を残し置換 MailItem.Copy WordEditorで置換

やりたいこと:
detail.chiebukuro.yahoo.co.jp

Outlookで下書きに保存したメールを元に作成してみたいメールがあります。
>文字列を日付に変換するだけなのですが、
>下書きに保存したメールには書式があります。
>OutlookVBAでReplaceしたら書式が消えてしまいました。
>因みにOutlookのデータをローカルに保存することはできません。

いつものデバッグ動画です
youtu.be
https://youtu.be/wiwvFYsCfBM
目次
00:00 やりたいこと
01:44 メールのチェック Selection.Count
02:34 1.下書きメールを.Copyで複製を作り
05:50 2.GetInspector().WordEditor で編集
06:22 3.編集はWord VBAの置き換えで
07:45 問題点.Copy時点でメールが複製されるのでキャンセル時・・・
08:24 説明まとめ と 再テスト実行(下書き修正手順を解説)

1.下書きメールを.Copyで複製を作り、
learn.microsoft.com

2.GetInspector().WordEditor で編集
learn.microsoft.com

3.編集はWord VBAの置き換え
learn.microsoft.com

をヒントにして、コードを作成。

With objDOC.Content.Find
    .Text = "置換品番"  '置換元
    .Forward = True
    .Replacement.Text = "ABC12345"  '置き換える文字
    .Execute Replace:=2  'wdReplaceAll=2 置換実行

みたいに、置き換えると、

>下書きに保存したメールには書式があります。
>OutlookVBAでReplaceしたら書式が消えてしまいました。

書式が残るかなぁ。

下記残念なソースですが

Sub test20220927選択下書きメールのコピーをテスト()

    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
    
    Dim oMAIL As Outlook.MailItem  'メールアイテム
    oSelectItem.Display '表示してからコピーしないとエラー?なんだろう?
    DoEvents  'これないと、エラー
    Set oMAIL = oSelectItem.Copy   '.Copyで複製を作成、oMailに代入
    '↑これで複製されるので、コピー元はすぐに.Closeで退場する
    oSelectItem.Close olDiscard  'olDiscard:1 変更内容を破棄 そもそもコピー元だしね
    
    '↑でCopy作成したメールを編集する
    'メールの本文を修正、ここでは、置き換えテスト
    oMAIL.Display  '表示する(表示しっぱなし、今回自動送信はしない)
    oMAIL.Subject = Format(Date, "yyyy/mm/dd") & "発注書"  '件名を変更

    Dim n As Long
    Dim objDOC As Object
    Set objDOC = oMAIL.GetInspector().WordEditor
    '↑.WordEditorであとは、Wordの世界っぽく処理

    With objDOC.Content.Find  '置き換えをバカっぽく三回固定値でテスト
        '品番
        .Text = "置換品番"  '置換元、この文字を検索して置換する
        .Forward = True
        .Replacement.Text = "ABC12345"  '置き換える文字
        .Execute Replace:=2  'wdReplaceAll=2 置換実行
    
        '品名
        .Text = "置換品名"  '置換元、この文字を検索して置換する
        .Forward = True
        .Replacement.Text = "Outlook .Copyで下書きメール複製"  '置き換える文字
        .Execute Replace:=2  'wdReplaceAll=2 置換実行
        
        '数量
        .Text = "置換数量"  '置換元、この文字を検索して置換する
        .Forward = True
        n = 1234567  'カンマのチェック用
        .Replacement.Text = Format(n, "#,###,##0")  '置き換える文字
        .Execute Replace:=2  'wdReplaceAll=2 置換実行
        
    End With
    
    MsgBox "処理終了、内容確認後、送信してください"

    '問題点、まずいことに気が付く、メールをコピーしているので、
    '変更を破棄しても、メールが残る・・・
    'おっとっと。まぁ今回は.Copyのテストってことで・・・

End Sub

アレンジして使ってみてください。

何か、勘違い回答をしたような気もしつつ、
解決のヒントとなれば幸いです。

Ken3 ホームページ 目次

分類:HPを大きく分けると4つの柱(分類)です。

  1. [VBA・マクロ プログラミング]の解説
    当店の人気はVBA系のCreateObject("XXXXXX.application")で他のアプリケーションを操作するサンプルが人気です
  2. [プログラマーの愚痴]では、あまり見せたくない三流プログラマーの内面かな。
    三流君を踏み台にする
  3. [古いクラシック ASP(Active Server Pages)]の解説。
  4. [元コンビニ店長時代の話]が弟に巻き込まれ、失敗した脱サラ、畑違い?の仕事で失敗。
主に上記4つの分類でHP作成やメルマガの発行を行ってます。
※更新頻度が落ちていて情報の鮮度が悪いです。



本当に三流なんです(笑):たまにスゴイですねなんて言われることもありますが、
真実は→ [三流君の真実は...] ←を初めに見てくださるとわかると思います。
(からくりは、成功例↑しか載せてなくて ヒドイ失敗例はお蔵入り迷宮入りが多かったりします)