Consulting

Results 1 to 5 of 5

Thread: GDPR issues - stopping Outlook users from using CC - Idea and thoughts to resolve

  1. #1
    VBAX Regular
    Joined
    Jun 2006
    Posts
    17
    Location

    GDPR issues - stopping Outlook users from using CC - Idea and thoughts to resolve

    Hi

    As GDPR starts to bite, and my patience with having to apologise to people who have been sent (or copied in!), information that wasn't meant for them, I'm looking at how I can reduce the number of times I have to declare a data protection breach.

    My initial thoughts were to use a macro that warned users when an email was being sent outside of the company's email server. This works fine;

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
        Dim recips As Outlook.Recipients
        Dim recip As Outlook.Recipient
        Dim pa As Outlook.PropertyAccessor
        Dim prompt As String
        Dim strMsg As String
        Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
        Set recips = Item.Recipients
        For Each recip In recips
            Set pa = recip.PropertyAccessor
            If InStr(LCase(pa.GetProperty(PR_SMTP_ADDRESS)), "@XXXXXXXX.com") = 0 Then
                strMsg = strMsg & "   " & pa.GetProperty(PR_SMTP_ADDRESS) & vbNewLine
            
            End If
        Next
        If strMsg <> "" Then
            prompt = "This email will be sent outside of XXXXXXXXXXX to:" & vbNewLine & strMsg & "Do you want to proceed?"
            If MsgBox(prompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "GDPR Alert!! Please Check Email Addresses") = vbNo Then
                Cancel = True
            End If
        End If
    End Sub
    However, users can exacerbate the problem by copying lots of people to maximise the GDPR breach for me.

    So, how can I stop them?

    Is there any way to simply remove the CC option (Probably impractical as we do need to send emails to more than one person!)

    or

    Can a macro take all the CC recipients and simply convert these to BCC recipients?

    or

    Is there another way to achieve this goal?

  2. #2
    You can certainly change the recipients from CC to BCC but I don't see how it addresses the issue of unwanted messages being sent out. CC or BCC, they still get sent.

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
        Set recips = Item.Recipients
        For Each recip In recips
            If recip.Type = olCC Then recip.Type = olBCC
        Next
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Jun 2006
    Posts
    17
    Location
    Hi Graham

    Thanks for this. I agree that the problem is between the ears of the members of staff who send emails without thinking, but the majority of events are just simply mistakes and oversights (as opposed to deliberate and intentional). I suspect there isn't a perfect solution, rather one that limits the opportunities to get it wrong.

  4. #4
    The programmers' job would be wonderful if it wasn't for the users.

    However on further reflection, you could check if the message was being sent by CC or BCC and check with the user to confirm. You could also check whether there were multiple recipients in the TO line, which I have added here. If there is only one recipient in the TO line there is no prompt.

    Option Explicit
    
    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    'Graham Mayor - https://www.gmayor.com - Last updated - 29 Jul 2019
    Dim recips As Outlook.Recipients
    Dim recip As Outlook.Recipient
    Dim strList As String, strTo As String
    Dim oColl_To As Collection, oColl_Copy As Collection
    Dim lngAsk As Long, i As Long
        Set recips = Item.Recipients
        Set oColl_To = New Collection
        Set oColl_Copy = New Collection
        For i = 1 To recips.Count
            Set recip = recips(i)
            If recip.Type = olCC Or recip.Type = olBCC Then
                oColl_Copy.Add recip.Address
            Else
                oColl_To.Add recip.Address
            End If
        Next i
        If oColl_Copy.Count > 0 Or oColl_To.Count > 1 Then
            strTo = ""
            For i = 2 To oColl_To.Count
                strTo = strTo & oColl_To(i) & vbCr
            Next i
            strList = ""
            For i = 1 To oColl_Copy.Count
                strList = strList & oColl_Copy(i) & vbCr
            Next i
            lngAsk = MsgBox("You are copying the current message to:" & vbCr & vbCr & strTo & strList & vbCr & _
                            "Are you sure you intended to do that?", vbYesNo)
            If lngAsk = vbNo Then Cancel = True
        End If
    lbl_Exit:
        Set recip = Nothing
        Set recips = Nothing
        Set oColl_To = Nothing
        Set oColl_Copy = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    Jun 2006
    Posts
    17
    Location
    Hi Graham

    Thanks for the macro, I've had a quick play around with it but from first testing, the cc to bcc conversion seems to have stopped working. I'll have a look further tomorrow to see if I can figure out why it's not playing nicely.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •