Outlook VBAを使用して、電子メールをクリップボードにコピーします

StackOverflow https://stackoverflow.com/questions/3949918

質問

電子メールをクリップボードにコピーしてから、テーブルをそのままにしてExcelに貼り付けるにはどうすればよいですか？

Outlook 2007を使用していますが、に相当するものをやりたいです 

"Click on email > Select All > Copy > Switch to Excel > Select Cell > Paste".

私はExcelオブジェクトモデルをかなりよく理解していますが、持っています いいえ 次のコード以外のOutlookでの経験。

Dim mapi As NameSpace
Dim msg As Outlook.MailItem
Set mapi = Outlook.Application.GetNamespace("MAPI")
Set msg = mapi.Folders.Item(1).Folders.Item("Posteingang").Folders.Item(1).Folders.Item(7).Items.Item(526)
役に立ちましたか？

解決

Outlook 2003でこれを使用していることを認めなければなりませんが、2007年にも機能するかどうかを確認してください。

使用できます msforms.dataobject クリップボードとデータを交換します。 Outlook VBAで、参照を作成します」Microsoftは2.0オブジェクトライブラリを形成します「、このコードを試してください（もちろん、サブ（）をボタンなどに添付できます）：

Sub Test()
Dim M As MailItem, Buf As MSForms.DataObject

    Set M = ActiveExplorer().Selection.Item(1)
    Set Buf = New MSForms.DataObject
    Buf.SetText M.HTMLBody
    Buf.PutInClipboard

End Sub

その後、Excelに切り替えてCtrl -Vを押します - そこに行きます！また、現在実行中のExcelアプリケーションを見つけて、これでさえ自動化したい場合は、私に知らせてください。

メールがプレーンテキストまたはRTFで送信された場合でも、常に有効なHTMLBodyがあり、ExcelはHTMLBodyを含むすべてのテキスト属性を表示します。ただし、列、色、フォント、ハイパーリンク、インデントなど。ただし、埋め込まれた画像はコピーされていません。

このコードは必需品を示していますが、実際にMaileItemが選択されているかどうかを確認しません。カレンダーのエントリ、連絡先などにも機能したい場合は、より多くのコーディングが必要になります。

リストビューでメールを選択した場合、それを開く必要さえありません。

他のヒント

私はついに再びそれを拾い上げ、完全に自動化しました。これが私がそれを自動化するためにしたことの基本です。

Dim appExcel As Excel.Application
Dim Buf As MSForms.DataObject
Dim Shape As Excel.Shape
Dim mitm As MailItem
Dim itm As Object
Dim rws As Excel.Worksheet
'code to open excel
Set appExcel = VBA.GetObject(, "Excel.Application") 
'...
'code to loop through emails here       
Set mitm = itm
body = Replace(mitm.HTMLBody, "http://example.com/images/logo.jpg", "")
Call Buf.SetText(body)
Call Buf.PutInClipboard
Call rws.Cells(i, 1).PasteSpecial
For Each Shape In rws.Shapes
    Shape.Delete 'this deletes the empty shapes
Next Shape
'next itm

ロゴURLを削除しました 時間を節約するために, 、そして300の電子メールを扱っているとき、それは少なくとも10分間の節約につながります。

必要なコードを入手しました TechRepublicの記事, 、それから私のニーズに合わせてそれを変更しました。クリップボードコードのこの質問の承認された回答者に感謝します。

わかりました、あなたの質問から欠落している情報があるので、私は特定の仮定をしなければなりません。まず、メッセージが何であるかを言うことはありませんでした... HTMLが最も簡単になります。RTFのプロセスは異なり、表面では不可能です。 HTML。

また、テーブルコンテンツを個別に貼り付けて（テーブルセルごとに1つのExcelセル）、残りの電子メールのボディテキストが1セルまたは複数に貼り付けられたいのかどうかは、質問からは明らかではありませんか？

最後に、VBAがOutlookやExcelから実行されたい場合は実際には言いませんでした（それほど重要ではありませんが、どの本質的なオブジェクトが利用可能かに影響します。

とにかくコードサンプル：htmlbodyプロップにアクセスするOutlookコード

Dim mapi As Namespace
Set mapi = Application.Session
Dim msg As MailItem
Set msg = mapi.Folders.Item(1).Folders.Item("Posteingang").Folders.Item(1).Folders.Item(7).Items.Item(526) 
Dim strHTML as String
strHTML = msg.HTMLBody
' There is no object model collection for html tables within the htmlbody (which is a string of html) you will need to parse the html and collect the tables before inserting into Excel.

もう一度しばらくして、私は別の方法を見つけました。 MailItem.Bodyは単純なテキストであり、テーブルセル間にタブ文字があります。だから私はそれを使った。これが私がしたことの要点です：

Sub Import()
    Dim itms As Outlook.Items
    Dim itm As Object
    Dim i As Long, j As Long
    Dim body As String
    Dim mitm As Outlook.MailItem
    For Each itm In itms
        Set mitm = itm
        ParseReports (mitm.body) 'uses the global var k
    Next itm
End Sub
Sub ParseReports(text As String)
    Dim table(1 To 1000, 1 To 11) As String 'I'm not expecting to see a thousand rows!
    Dim drow(1 To 11) As String
    For Each Row In VBA.Split(text, vbCrLf)
        j = 1
        For Each Col In VBA.Split(Row, vbTab)
            table(i, j) = Col
            j = j + 1
        Next Col
        i = i + 1
    Next Row
    For i = 1 To l
        For j = 1 To 11
            drow(j) = table(i, j)
        Next j
        hws.Range(hws.Cells(k, 1), hws.Cells(k, 11)) = drow
        k = k + 1
    Next i
End Sub

平均：77メール 処理 毎秒。私はいくつかのマイナーな処理と抽出を行います。

ライセンス： CC-BY-SA と 帰属
所属していません StackOverflow
scroll top