MS Outlook VBA Module for copying the message ID of the current mail into clipboard

MailMsgIdToClipboard.bas

Public Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
Public Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Public Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Public Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal uFormat As Long, ByVal hMem As LongPtr) As LongPtr
Public Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
Public Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Public Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Public Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As LongPtr, ByVal lpString2 As String) As LongPtr

Public Const GHND = &H42
Public Const CF_TEXT = 1

Sub CopyEntryIDToClipboard()
    Dim objMail As Object
    Dim objSelection As Selection
    Dim strEntryID As String
    Dim strSubject As String
    Dim strMarkdownLink As String

    ' Überprüfen Sie, ob eine E-Mail ausgewählt ist
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox "Bitte wählen Sie eine E-Mail aus.", vbExclamation
        Exit Sub
    End If
    
    ' Holen Sie die ausgewählte E-Mail
    Set objSelection = Application.ActiveExplorer.Selection
    Set objMail = objSelection.Item(1)

    ' Überprüfen Sie, ob das ausgewählte Element eine MailItem ist
    If TypeName(objMail) <> "MailItem" Then
        MsgBox "Das ausgewählte Element ist keine E-Mail.", vbExclamation
        Exit Sub
    End If

    ' Holen Sie die EntryID und den Betreff der E-Mail
    strEntryID = objMail.EntryID
    strSubject = objMail.Subject

    ' Erstellen Sie den Markdown-Link
    strMarkdownLink = "[" & strSubject & "](outlook:" & strEntryID & ")"

    ' Kopieren Sie den Markdown-Link in die Zwischenablage
    Call SetClipboardText(strMarkdownLink)

    MsgBox "Markdown-Link wurde in die Zwischenablage kopiert: " & strMarkdownLink, vbInformation
End Sub

Sub SetClipboardText(text As String)
    Dim hGlobal As LongPtr
    Dim lpGlobal As LongPtr

    ' Öffnen Sie die Zwischenablage
    If OpenClipboard(0&) Then
        ' Löschen Sie die aktuelle Zwischenablage
        Call EmptyClipboard

        ' Allokieren Sie globalen Speicher
        hGlobal = GlobalAlloc(GHND, Len(text) + 1)

        ' Sperren Sie den globalen Speicher, um den String zu kopieren
        lpGlobal = GlobalLock(hGlobal)
        Call lstrcpy(lpGlobal, text)

        ' Entriegeln Sie den globalen Speicher
        Call GlobalUnlock(hGlobal)

        ' Setzen Sie den Text in die Zwischenablage
        Call SetClipboardData(CF_TEXT, hGlobal)

        ' Schließen Sie die Zwischenablage
        Call CloseClipboard
    End If
End Sub