Outlook 2003 Macro to copy selected Mails with full Mail headers into Clipboard Needs "Microsoft Forms 2.0 Object Library" (WIN/system32/FM20.dll) und "Microsoft CDO 1.21 Library" (SHARED/system/msmapi/1031/cdo.dll)

CopySelectedMessagesHeadersToClipboard.outlook2003.vba

' Source https://gist.github.com/hilbix/5597981
Public Sub CopySelectedMessagesHeadersToClipboard()
    Dim sel As Outlook.Selection
    Dim msg As Outlook.MailItem
    Dim n As Integer
    Dim all As String
    Dim errcnt As Integer
    Dim omsg As Object
    Dim mmsg As MAPI.Message
    Dim spid As String, seid As String
    ' http://www.slipstick.com/outlook-developer/code-samples/internet-header-vba-code-sample/
    Dim sess As New MAPI.Session
    
    ' http://www.dimastr.com/redemption/rdo/rdosession.htm
    ' analogon
    sess.MAPIOBJECT = Application.Session.MAPIOBJECT
    
    Set sel = ActiveExplorer.Selection
    all = ""
    errcnt = 0
    For n = 1 To sel.Count
      Set omsg = sel.Item(n)
      
      If Not TypeOf omsg Is Outlook.MailItem Then
        errcnt = errcnt + 1
      Else
        Set msg = omsg
        ' http://www.office-loesung.de/ftopic123191_0_0_asc.php
        ' This needs a reference to C:\Programme\Gemeinsame Dateien\System\MSMAPI\1031\CDO.DLL
        Set mmsg = sess.GetMessage(msg.EntryID, msg.Parent.StoreID)
        all = all & mmsg.Fields(CdoPR_TRANSPORT_MESSAGE_HEADERS) & vbCrLf
        'all = all & "From: " & msg.SenderName & vbCrLf
        'all = all & "To: " & msg.To & vbCrLf
        'all = all & "Subject: " & msg.Subject & vbCrLf
        all = all & msg.Body & vbCrLf
        all = all & vbCrLf
        'msg.UnRead = False
      End If
    Next n
    
    If errcnt > 0 Then MsgBox "Error count = " & errcnt, , "OOPS"
    
    ' http://stackoverflow.com/questions/5552299/how-to-copy-to-clipboard-using-access-vba
    ' this needs a reference to c:\windows\system\fm20.dll
    Dim Clipboard As New MSForms.DataObject
    Clipboard.SetText all
    Clipboard.PutInClipboard
End Sub