Outlookメール本文を抽出することについて

Question

実現したいこと

EXCEL VBAでコードを書いています。
Outlookで受信したメール本文をExcelに張り付ける際に、一つのセルにメール本文全てが張り付いてしまう。メール本文で改行されていたら下のセルに本文を貼り付けたい。
追加部分のコードを書かずに、複数行のセルにまたがって本文を貼り付けたい。

発生している問題・分からないこと

このようになってしまう

このようにしたい

エラーメッセージ

エラーメッセージはないです。

該当のソースコード

Sub Test1()

’Microsoft Outlook 16.0 Object Library　と　Microsoft Scripting Runtimeは参照設定されている。

Dim appOL As Outlook.Application

Set appOL = New Outlook.Application

Dim objExplorers As Explorers

Set objExplorers = appOL.Explorers

'Debug.Print objExplorers.Item(1).Selection.Item(1).Subject

Worksheets(1).Range("B2").Value = objExplorers.Item(1).Selection.Item(1).Subject
'
'Debug.Print objExplorers.Item(1).Selection.Item(1).Body

Worksheets(1).Range("B4").Value = objExplorers.Item(1).Selection.Item(1).Body

’----この部分を追加し、作成された123.txtを開いて「全て選択」→任意のセルにコピーペーストすると複数行のセルに跨ってペーストされる。----

Dim str1 As String

str1 = objExplorers.Item(1).Selection.Item(1).Body

Dim myFSO As FileSystemObject
Set myFSO = New FileSystemObject
Dim myText As TextStream
Set myText = myFSO.CreateTextFile("C:\123.txt")
E:
myText.WriteLine str1


myText.Close
Set myText = Nothing
Set myFSO = Nothing

’----この部分を追加し、作成された123.txtを開いて「全て選択」→任意のセルにコピーペーストすると複数行のセルに跨ってペーストされる。　終わり----

End Sub

試したこと・調べたこと

• teratailやGoogle等で検索した
• ソースコードを自分なりに変更した
• 知人に聞いた
• その他

上記の詳細・結果

単にメモ帳に書いたテキスト文をエクセルにコピーペーストしても、一つのセルにまとまらずに複数行のセルにペーストされる。　一つのセルにペーストされる場合と複数行にペーストされる場合と違いが分からない。

補足

単にメモ帳に書いたテキスト文をエクセルにコピーペーストしても、一つのセルにまとまらずに複数行のセルにペーストされる。　一つのセルにペーストされる場合と複数行にペーストされる場合と違いが分からない。

Comments

[meg_]

「上記の詳細・結果」と「補足」の文章が同一のようです。記入ミスでしょうか？ご確認ください。

> ソースコードを自分なりに変更した
上記についても”どう”変更されて結果がどうだったのか教えていただけますか？

[u_zu]

＞「上記の詳細・結果」と「補足」の文章が同一のようです。記入ミスでしょうか？ご確認ください。

何か書かなくてはいけなかったので、同じ文章をいれました。

>上記についても”どう”変更されて結果がどうだったのか教えていただけますか？

変更した、というよりは　追加のコードを入れてみて試してみた、という感じです。
追加コードを省略した場合、一つのセルにすべての「メール本文」がセットされてしまうので、
改行に合わせて複数セルにメール本文をセットしたい、ということです。

Answer 1

Outlookで受信したメール本文をExcelに張り付ける

メール本文で改行されていたら下のセルに本文を貼り付けたい。

次のようなマクロを実行できれば良い、ということでしょうか。

Sub CopyMailBodyFromOutlook()
    
    Dim olkApp As Outlook.Application
    
    On Error Resume Next
    '実行中の Outlook アプリケーションを参照
    Set olkApp = GetObject(, "Outlook.Application")
    '参照に失敗した場合
    If Err.Number <> 0 Then
        Err.Clear
        On Error GoTo 0
        'Outlook アプリケーションの新規インスタンスを生成して参照
        Set olkApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    Dim olkNameSpace As Outlook.Namespace
    Dim olkAccount As Outlook.Account

    '最初のアカウントを参照
    Set olkNameSpace = olkApp.GetNamespace("MAPI")
    Set olkAccount = olkNameSpace.Accounts.Item(1)
    
    Debug.Print "参照したアカウントの表示名: " & olkAccount.DisplayName
    
    Dim olkFolderInbox As Outlook.Folder
    Dim olkItems As Outlook.Items
    
    'そのアカウントの既定の[受信トレイ]フォルダの参照
    Set olkFolderInbox = olkAccount.Session.GetDefaultFolder(olFolderInbox)
    'そのフォルダ内のアイテムコレクションを参照
    Set olkItems = olkFolderInbox.Items
    
    'アイテムが1つもなければメッセージボックスを表示して終了
    If olkItems.Count = 0 Then
        MsgBox "アカウント'" & olkAccount.DisplayName & "'の受信トレイの中にアイテムがありません。", _
               vbExclamation, _
               "アイテムなし"
        Set olkItems = Nothing
        Set olkFolderInbox = Nothing
        Set olkAccount = Nothing
        Set olkNameSpace = Nothing
        Set olkApp = Nothing
        Exit Sub
    End If
    
    '[受信日時]プロパティの降順にアイテムをソート
    olkItems.Sort "[ReceivedTime]", True
    
    Dim olkItem As Object   'Outlook.MailItem または Outlook.MeetingItem
    
    '最初のアイテムを参照
    Set olkItem = olkItems.GetFirst
    
    Debug.Print "件名:" & olkItem.Subject
    Debug.Print "受信日時:" & olkItem.ReceivedTime
    
    Dim wsDestination As Excel.Worksheet
    
    'このブックの1つめのワークシートを参照
    Set wsDestination = ThisWorkbook.Worksheets(1)

    Application.ScreenUpdating = False

    'そのワークシートを選択
    wsDestination.Select
    
    '全てのセルをクリア
    wsDestination.Cells.Clear
    '全てのセルの表示形式を一時的に「文字列」にする
    wsDestination.Cells.NumberFormat = "@"
    
    '行見出しの設定
    wsDestination.Cells(2, 1).Value = "件名:"
    wsDestination.Cells(4, 1).Value = "本文:"
    
    'B2セルに件名を代入
    wsDestination.Cells(2, 2).Value = olkItem.Subject
    
    'アイテムの本文をクリップボードにコピー
    olkItem.GetInspector.WordEditor.Content.Copy
    
    'B4セルを選択
    wsDestination.Cells(4, 2).Select
    'Unicode テキスト形式で貼り付け
    wsDestination.PasteSpecial Format:="Unicode テキスト", _
                               Link:=False, _
                               DisplayAsIcon:=False
        
    'B2セルを選択
    wsDestination.Cells(2, 2).Select
    
    '全てのセルの表示形式を「標準」にする
    wsDestination.Cells.NumberFormat = "General"
    
    Application.ScreenUpdating = True
    
    Set olkItem = Nothing
    Set olkItems = Nothing
    Set olkFolderInbox = Nothing
    Set olkAccount = Nothing
    Set olkNameSpace = Nothing
    Set olkApp = Nothing
    
    Set wsDestination = Nothing
    
End Sub

Comments

[u_zu]

sk.exeさん　どうもありがとうございます。
やりたいことはこのコードで実現できます。すごいです。

PasteSpecial Format:="Unicode　という感じで実現できるんですね。
このコードで登場するPasteSpecialは　よくエクセルVBAの本で見る、PasteSpecialメソッドとは
違うんですか？　FormatとかLinkなどの引数は見たことはないので。

ネットで調べると、「指定された形式で、クリップボードの内容をシートに貼り付けます。
他のアプリケーションからデータを貼り付けるときや、あるいは特別な形式でデータを貼り付ける場合に
使います。」

とあり、エクセルだけで完結する場合以外で活用するように思われるので。

[sk.exe]

> このコードで登場するPasteSpecialは　よくエクセルVBAの本で見る、
> PasteSpecialメソッドとは違うんですか？

Range オブジェクトの PasteSpecial メソッドではなく、
Worksheet オブジェクトの PasteSpecial メソッドを呼び出しています。

Range.PasteSpecial メソッド (Excel):
https://learn.microsoft.com/ja-jp/office/vba/api/excel.range.pastespecial

Worksheet.PasteSpecial メソッド (Excel):
https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheet.pastespecial

前者は「コピーされたセル範囲を任意の形式で別のセル範囲に貼り付ける」場合に、
後者は「別のアプリケーションからクリップボードにコピーされたデータ
（テキスト、画像、オブジェクトなど）を任意のワークシートのアクティブセルに
貼り付ける」場合に使用します。

今回の場合は Outlook のメッセージウィンドウからその本文をクリップボードにコピーし、
貼り付け先として B4 セルをアクティブセルにしてから Unicode テキスト形式で
（プレーンテキストのみの）貼り付けを実行するようにしています。

クリップボードにコピーされたのが「改行文字やタブ文字を含むテキスト」である場合は、
貼り付けが実行される際に Excel が自動的に解釈して貼り付け先の範囲を拡張します。

[u_zu]

sk.exeさん　どうもありがとうございます。ご提示いただいた、

Worksheet.PasteSpecial メソッド (Excel):
https://learn.microsoft.com/ja-jp/office/vba/api/excel.worksheet.pastespecial

のサイトを見たのですが、今回のFormatパラメーターに指定されている、"Unicode テキスト"　のような
引数の一覧？のようなものはどこで調べたらよろしいのでしょうか？ググったのですが、可能な引数を
列挙しているようなサイトは見当たらず。。。自分で色々と試してみたいのですが、参考サイトなどを
御存じでしたら御教示お願いできないでしょうか？

[sk.exe]

> 今回のFormatパラメーターに指定されている、
> "Unicode テキスト"　のような引数の一覧？のようなものは
> どこで調べたらよろしいのでしょうか？

引数 Format に渡すことが出来る文字列は、その時点においてクリップボードに
コピーされているデータの形式、および実行環境の言語によって異なります。
全ての組み合わせを網羅した公式ドキュメントは公開されていません。

基本的には、別のアプリケーション（今回の場合は Outlook ）から任意のデータが
クリップボードにコピーされた状態で Excel 側で[形式を選択して貼り付け]コマンドを
呼び出した際に選択可能な形式のいずれか1つを示す文字列を記述することになります。

よく分からない場合は[マクロの記録]機能を使用し、自動作成された
マクロのコードを参考になさればよいでしょう。

[u_zu]

sk.exeさん　どうもありがとうございます。 大変参考になりました。

Answer 2

特定セルのvalueに文字列（メールのBodyプロパティーは文字列型）を代入したらそうなります。

「文字列を改行で分割して、複数のセル（同じ列の複数行）にそれぞれの行を入れたい」
がやりたいことであれば、そのままそれをプログラムにするのが簡明だと思います。
文字列をsplit関数で分割して、あとはループするだけ。

別案としては、データリボンの「区切り位置」の機能に該当するTextToColumnsというメソッドがあるので、まず1セルに全部代入して、このメソッドで改行で横方向に分割した後、縦横転置するというのも考えられますが、上の案に対してのメリットがなさそう。余計面倒な気がします。
もしTextToRowsのようなメソッドがあればそれを使えば良いですが、無いのでそれは無理。

Comments

[u_zu]

otnさん　ありがとうございます。

＞「文字列を改行で分割して、複数のセル（同じ列の複数行）にそれぞれの行を入れたい」
がやりたいことであれば、そのままそれをプログラムにするのが簡明だと思います。
文字列をsplit関数で分割して、あとはループするだけ。

この部分は理解できるのですが、メモ帳などで改行がある文章全体を選択→コピーして
エクセルの任意のセルにペーストすると、複数セルに貼り付けられて、やりたいことと
同じことが出来るんですよね。仰っておられる、「特定セルのValueに文字列を代入」しているのと
異なる、ということなのでしょうか？
御存じでしたら教えてください。

[otn]

お書きの「メモ帳からコピペ」は、Excel側から見ると「クリップボード内容をペースト」ですね。やってることは全然違います。
そうか、そういう案もありますね。
と、思ったらすでに回答されていた。sk.exeさんのコードが完全に理解できたのならそれで良いかと思います。
私の回答の前半は、「VBAの基本の理解だけでできる」という意味で、簡明と書きました。

[u_zu]

otnさん　どうもありがとうございます。参考になりました。