Attribute VB_Name = "Module1"
Sub ReportNotSpam()
    Const SPAM_ADDRESS = "notspam@yourdomain.com"
    Report (SPAM_ADDRESS)
End Sub

Sub ReportSpam()
    Const SPAM_ADDRESS = "spam@yourdomain.com"
    Report (SPAM_ADDRESS)
End Sub


Sub Report(email As String)
  Const ASKVERIFY = True 'Set to true to ask if the user is sure (only for reportSpam)
  Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E
  
  'Dim oIExplorer As MSHTML.HTMLDocument
  Dim oItem As MailItem, oForwardItem As MailItem
  Dim oMessage As MailItem
  Dim oNS As NameSpace
  Dim oSelection As Selection
  Dim oSession As Outlook.NameSpace
  'Dim sMsg As String, sHeader As String, sBody As String
  Dim sEntry As String
  Dim iIdx As Integer, iLoop As Integer
  Dim dtDeferDate As Date
  
  Dim ii As ItemProperty
  
  
  Set oNS = Application.GetNamespace("MAPI")
  Set oSelection = oNS.GetDefaultFolder(olFolderInbox).Application.ActiveExplorer.Selection
  
  'make sure at least one email message is highlighted/selected
  If oSelection.Count > 0 Then
  'defer delvery time so that any anti-virus program's outbound scan
  'won't get overwhelmed and lock up
  dtDeferDate = DateAdd("s", 5 + oSelection.Count, Now)
  'operate on each selected email message, one at a time
  For Each oItem In oSelection
  'Ensure selected item is an email message
  If oItem.Class = olMail Then
  sEntry = oItem.EntryID
  Set oSession = Application.Session
  
  oSession.Logon "", "", False, False
  
  'get an MAPI reference to the email
  Set oMessage = oSession.GetItemFromID(sEntry)
  
  'get the header
  'sHeader = oMessage. (CdoPR_TRANSPORT_MESSAGE_HEADERS)
  
  'get the body of the message
  'If oItem.GetInspector.EditorType = olEditorHTML Then
  '  Set oIExplorer = oItem.GetInspector.HTMLEditor
  '  DoEvents 'to stop the occasional error
  '  sMsg = oIExplorer.documentElement.outerHTML
  'Else
  '  sMsg = oItem.Body
  'End If
  
  'set the body of the message to be forwarded to Spam
  'sBody = sHeader + sMsg
  'sBody = sMsg
  
  'create a new email message to be forwarded to Spam
  Set oForwardItem = Application.CreateItem(olMailItem)
  With oForwardItem
  .Recipients.Add email
  .Subject = "Spam Report"
  .Attachments.Add oItem
  .DeleteAfterSubmit = True
  .DeferredDeliveryTime = dtDeferDate
  .Send
  End With
  DoEvents
  oItem.UnRead = False
  oItem.Delete
  
  'clean up the objects
  Set oForwardItem = Nothing
  'Set oIExplorer = Nothing
  Set oMessage = Nothing
  Set oSession = Nothing
  'take a look at what was sent
  'Debug.Print sBody
  Else
    MsgBox "This macro only works on email messages."
  End If
  Next
  End If
  Set oSelection = Nothing
  Set oNS = Nothing
End Sub

' Добавляет панель спам или не спам
Sub addSpamNotSpamButton()
    Const CAPTION_TOOLBAR = "Spam toolbar"
    Const CAPTION_SPAM_BUTTON = "Spam"
    Const CAPTION_NOTSPAM_BUTTON = "Ham"

    Dim cb As CommandBarButton
    Dim cbs As CommandBar
    
    Set cbs = Application.Explorers.Item(1).CommandBars.Add(CAPTION_TOOLBAR)
    Set cb = cbs.Controls.Add(msoControlButton, 1)
    cb.Caption = CAPTION_NOTSPAM_BUTTON
    cb.FaceId = 1
    cb.OnAction = "ReportNotSpam"
    Set cb = cbs.Controls.Add(msoControlButton, 1)
    cb.Caption = CAPTION_SPAM_BUTTON
    cb.FaceId = 2
    cb.OnAction = "ReportSpam"
    
    cbs.Visible = True

End Sub