やりたいこと:
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
アレンジして使ってみてください。
何か、勘違い回答をしたような気もしつつ、
解決のヒントとなれば幸いです。