Sub gethtmlbody()
'получаем HTMLbody из выделенного письма в Outlook
Dim objOutlookApp As Object, objMail As Object
Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
Dim lr As Long, lLastR As Long
Dim flag As Byte
flag = 0
Application.ScreenUpdating = False
ActiveSheet.DisplayPageBreaks = False
On Error Resume Next
'пробуем подключиться к Outlook, если он уже открыт
Set objOutlookApp = GetObject(, "Outlook.Application")
Err.Clear 'Outlook закрыт, очищаем ошибку
If objOutlookApp Is Nothing Then
Set objOutlookApp = CreateObject("Outlook.Application")
End If
'произошла ошибка создания объекта - выход
If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub
objOutlookApp.session.Logon
Set obj_inspector = objOutlookApp.explorers.Item(1).Selection.Item(1)
s_htm = obj_inspector.htmlbody
Range("A1").Value = s_htm
End Sub
|