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

Question

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

Answer 1

Я должен признать, что использую это в 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, включая. столбцы, цвета, шрифты, гиперссылки, отступы и т. д. Однако встроенные изображения не копируются.

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

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

Answer 2

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

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 , а затем изменил его в соответствии со своими потребностями.Большое спасибо принятому ответчику на этот вопрос за код буфера обмена.

Answer 3

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

Answer 4

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

Также из вашего вопроса не ясно, хотите ли вы, чтобы содержимое таблицы вставлялось отдельно (1 ячейка Excel на ячейку таблицы), а остальная часть текста сообщения электронной почты вставлялась в одну или несколько ячеек?

наконец, вы на самом деле не сказали, хотите ли вы, чтобы 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.