Results 1 to 2 of 2
2013-01-22, 10:28 #1
- Join Date
- Dec 2009
- Verona, WI
- Thanked 0 Times in 0 Posts
Search for addressee in current email
Some email I get has been sent to a very long list of addressees. I need to determine whether it has been sent to specific people so I can avoid forwarding it to them unnecessarily. After grousing about it for a long while I finally broke down and wrote a macro that makes that process easier. When invoked from an open email, it pops up a dialog box asking me who I am searching for then pops up another one telling me if it found that name in the addressee list. I thought I'd share the code in case anyone else finds it useful.
Sub SearchForAddressee() ' Search the current message for an addressee ' January 22, 2013 ' Jeff Erickson Dim strAddressees As String, strAddressees1 As String, strAddressees2 As String, strAddresseesU As String, strFindThis As String Dim vCarryOn As Variant, vReturn As Variant, intWhere As Integer vCarryOn = False ' Figure out if the active window is a list of messages or ' one message in its own window On Error GoTo QuitIfError ' But if there's a problem, quit gracefully Select Case Application.ActiveWindow.Class Case olExplorer ' The active window is a list of messages (folder); this means there ' might be several selected messages MsgBox "This only works for messages that are open - at least for now." vCarryOn = False Case olInspector ' The active window is a message window, meaning there will only ' be one selected message (the one in this window) strAddressees = "To: " & Application.ActiveInspector.CurrentItem.To strAddressees = strAddressees & vbCrLf & "CC: " & Application.ActiveInspector.CurrentItem.CC strAddressees = strAddressees & vbCrLf & "BCC: " & Application.ActiveInspector.CurrentItem.BCC vCarryOn = True End Select If vCarryOn Then ' Put list in clipboard vReturn = ClipboardSetText(strAddressees) ' Ask what to search for strFindThis = InputBox("Who are you looking for?", "Find Email in addressee list", Default) 'Cancel if Cancel button clicked If strFindThis = "" Then MsgBox "Cancelled" Else strFindThis = UCase(strFindThis) strAddresseesU = UCase(strAddressees) ' Search the string intWhere = InStr(strAddresseesU, strFindThis) If (intWhere > 0) Then strAddressees1 = Mid(strAddressees, 1, intWhere - 1) strAddressees2 = Mid(strAddressees, intWhere) strAddressees = "******FOUND****** at position " & intWhere & vbCrLf & vbCrLf strAddressees = strAddressees & strAddressees1 & vbCrLf & vbCrLf & "*********Here:" & vbCrLf & strAddressees2 Else strAddressees = "******NOT FOUND******" & vbCrLf & vbCrLf & strAddressees End If strAddressees = "Searched for: " & strFindThis & " " & strAddressees & vbCrLf & "Addressees are in the clipboard." MsgBox strAddressees End If End If GoTo Cleanup QuitIfError: ' Come here if there was some kind of problem MsgBox ("Encountered an error") ' I should add something more useful here. Cleanup: 'Nothing to do End Sub
2013-01-22, 13:44 #2
- Join Date
- Dec 2009
- Thanked 897 Times in 829 Posts
The downside is if the sender uses Blind Copy.