OpenNTF Mail Experience - Feature Request: Copy e-mail adresses to clipboard
Had the need the other day to send an e-mail to several recepients that I had received an e-mail from. And could for my life not find a simple way to "copy" their adresses not to "Reply to selected". Nicked som code from the net and put the following agent together. Copies the mail-adresses from the selected e-mail (Windows only though).'
AGENT "Copy senders address"
'DECLARATIONS
Declare Private Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( Byval strDest As Any, Byval lpSource As Any, Byval Length As Any)
Declare Private Function GlobalAlloc Lib "kernel32" (Byval uFlags As Long, Byval dwBytes As Long) As Long
Declare Private Function GlobalFree Lib "kernel32" (Byval hMem As Long) As Long
Declare Private Function GlobalLock Lib "kernel32" (Byval hMem As Long) As Long
Declare Private Function GlobalUnlock Lib "kernel32" (Byval hMem As Long) As Long
Declare Private Function OpenClipboard Lib "user32" (Byval hWnd As Long) As Long
Declare Private Function GetClipboardData Lib "user32" (Byval uFormat As Long) As Long
Declare Private Function CloseClipboard Lib "user32" () As Long
Declare Private Function EmptyClipboard Lib "user32" () As Long
Declare Private Function SetClipboardData Lib "user32" (Byval uFormat As Long, Byval hData As Long) As Long
'Clipboard Constants...
Private Const GMEM_MOVABLE = &H2&
Private Const GMEM_DDESHARE = &H2000&
Private Const CF_TEXT = 1
Private Const CANNOTOPENCLIPBOARD = 2
Private Const CANNOTGLOBALLOCK = 4
Private Const CANNOTCLOSECLIPBOARD = 5
Private Const CANNOTGLOBALALLOC = 6
Private Const CANNOTEMPTYCLIPBOARD = 7
Private Const CANNOTSETCLIPBOARDDATA = 8
Private Const CANNOTGLOBALFREE = 9
'/end decl
Sub Initialize
Dim nsession As New NotesSession
Dim doc As NotesDocument
Dim db As notesdatabase
Dim sendTo As String
Set db = nsession.Currentdatabase
Dim dc As NotesDocumentCollection
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
sendto = ""
Do While Not doc Is Nothing
sendTo = sendTo + ";" + doc.From(0)
Set doc = dc.GetNextDocument( doc)
Loop
Call fSendToClipboard( sendTo)
End Sub
Function fSendToClipboard(strText As String) As Variant
Dim varRet As Variant
Dim fStClpData As Long
Dim hMem As Long
Dim lpMemory As Long
Dim lngSize As Long
Dim varTemp As Variant
varRet = False
fStClpData = False
lngSize = Len(strText) + 1
hMem = GlobalAlloc(GMEM_MOVABLE Or _
GMEM_DDESHARE, lngSize)
If (hMem) =0 Or Isnull(hMem)Then
varRet = Error(CANNOTGLOBALALLOC)
Goto sTxtDone
End If
lpMemory = GlobalLock(hMem)
If (lpMemory) =0 Or Isnull(lpMemory) Then
varRet = Error(CANNOTGLOBALLOCK)
Goto sTxtGlblFree
End If
Call MoveMemory(lpMemory, strText, lngSize)
Call GlobalUnlock(hMem)
varTemp = (OpenClipboard(0&))
If varTemp=0 Or Isnull(varTemp) Then
varRet = Error(CANNOTOPENCLIPBOARD)
Goto sTxtGlblFree
End If
varTemp = (emptyClipboard())
If varTemp=0 Or Isnull(varTemp) Then
varRet = Error(CANNOTEMPTYCLIPBOARD)
Goto fSendToClipboardCloseClipboard
End If
varTemp = SetClipboardData(CF_TEXT, hMem)
If varTemp=0 Or Isnull(varTemp) Then
varRet = Error(CANNOTSETCLIPBOARDDATA)
Goto fSendToClipboardCloseClipboard
Else
fStClpData = True
End If
fSendToClipboardCloseClipboard:
varTemp = closeclipboard()
If varTemp=0 Or Isnull(varTemp) Then
varRet = Error(CANNOTCLOSECLIPBOARD)
End If
sTxtGlblFree:
If Not fStClpData Then
varTemp = globalfree(hmem)
If varTemp=0 Or Isnull(varTemp) Then
varRet = Error(CANNOTGLOBALFREE)
End If
End If
sTxtDone:
fSendToClipboard = varRet
End Function