PDA

View Full Version : GDPR issues - stopping Outlook users from using CC - Idea and thoughts to resolve



DaveR
07-26-2019, 07:00 AM
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?:banghead:

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?

gmayor
07-27-2019, 03:46 AM
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

DaveR
07-29-2019, 01:09 AM
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.

gmayor
07-29-2019, 05:08 AM
The programmers' job would be wonderful if it wasn't for the users.:banghead:

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

DaveR
08-01-2019, 04:54 AM
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.