Копирование электронной почты в буфер обмена с Outlook VBA

Как скопировать электронное письмо в буфер обмена, а затем вставить его в 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)

4 ответов


Я должен признать, что я использую это в Outlook 2003, но, пожалуйста, посмотрите, работает ли он в 2007 году:

можно использовать MSForms.Объект dataObject обмен данными с буфером обмена. В Outlook VBA создайте ссылку на"Библиотека Объектов Microsoft Forms 2.0", и попробуйте этот код (вы можете, конечно, прикрепить Sub () к кнопке и т. д.):

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 и автоматизация даже этого, дайте мне знать.

всегда есть допустимое HTMLBody, даже когда почта была отправлена в виде обычного текста или RTF, и Excel отобразит все текстовые атрибуты, переданные в HTMLBody incl. столбцы, цвета, шрифты, гиперссылки, отступы и т. д. Однако, встроенные изображения не копируются.

этот код демонстрирует основы, но не проверяет, действительно ли выбран MailItem. Это потребует больше кодирования, если вы хотите, чтобы он работал для записи календаря, контакты и т. д. также.

достаточно, если вы выбрали почту в представлении списка, вам даже не нужно ее открывать.


Я, наконец, снова взял его и полностью автоматизировал его. Вот основы того, что я сделал, чтобы автоматизировать его.

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 электронных писем, это переводится по крайней мере в десять минут сохранены.

Я получил код, который мне нужен от статья TechRepublic, а затем изменил его в соответствии с моими потребностями. Огромное спасибо принятого ответа на этот вопрос для буфера обмена код.


хорошо, поэтому мне придется сделать определенные предположения, потому что в вашем вопросе отсутствует информация. Во-первых, вы не сказали, что mailformat сообщение... HTML будет самым простым, процесс будет отличаться для RTF и невозможен в открытом тексте Поскольку вы ссылаетесь на таблицы, я предположу, что они являются таблицами HTML, а формат почты-HTML.

также неясно из вашего вопроса, Хотите ли вы, чтобы содержимое таблицы вставлялось отдельно (1 ячейка excel на ячейку таблицы) а остальные письма bodytext вставлены в 1 ячейку или несколько?

наконец, вы действительно не сказали, Хотите ли вы, чтобы VBA работал из Outlook или Excel (не так важно, но это влияет на то, какие внутренние объекты доступны.

в любом случае пример кода : Код Outlook для доступа к htmlbody prop

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.Тело является обычным текстом и имеет символ табуляции между ячейками таблицы. Поэтому я использовал это. Вот суть того, что я сделал:--2-->

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 сообщений обработки в секунду. Я делаю небольшую обработку и извлечение.