If statement based on email's text colour

[tunam8]

Evening all, I've been grappling with a small if statement that would check the text colour of the email body. This is what I have so far. I cant figure out what I should be using instead of the body. part seen below. Any help would be greatly appreciated.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)


'On Error Resume Next



If Body.Font.ColorIndex = 3 Then
MsgBox "RED!"
End If

End Sub

[skatonni]

You will not find this in Outlook.

https://msdn.microsoft.com/en-us/library/office/ff866465(v=office.14).aspx

In the Visual Basic Editor, Tools menu, References option, add the Microsoft Word Object Library.



Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim objInsp As Inspector

Dim objWord As Word.Application
Dim objDoc As Word.Document
Dim objSel As Word.Selection

If Item.Class = olMail Then
Set objInsp = Item.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
End If
End If

Debug.Print objSel

Select Case objSel.Font.ColorIndex
Case wdRed
MsgBox "RED!"
Case wdBlue
MsgBox "Blue!"
End Select

End Sub

[tunam8]

perfecto. Ill just need to figure out how to set the colorindex to the specific colours I'm looking for (hopefully something using RGB)

[gmayor]

You can do it without the reference to Word by using late binding to Word and you can use RGB colour values by checking the Color property as opposed to the ColorIndex property.

(ColorCop is a great way of determining RGB values, if you don't know them)

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim objInsp As Inspector
Dim objWord As Object
Dim objDoc As Object
Dim objSel As Object
If Item.Class = olMail Then
Set objInsp = Item.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
End If
End If
Select Case objSel.Font.Color
Case RGB(255, 0, 0)
MsgBox "RED!"
Case RGB(0, 0, 255)
MsgBox "Blue!"
End Select
End Sub

[tunam8]

thanks for all the help. I seem to have a problem getting the script to run when editing emails for forwarding

[gmayor]

The macro runs when the message (including forwarded) is sent. What EXACTLY are you faced with and what are you trying to do as a consequence?
The following modification will show a further message if the conditions are not matched.


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objInsp As Inspector
Dim objWord As Object
Dim objDoc As Object
Dim objSel As Object
If Item.Class = olMail Then
Set objInsp = Item.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
End If
End If
Select Case objSel.Font.Color
Case RGB(255, 0, 0)
MsgBox "RED!"
Case RGB(0, 0, 255)
MsgBox "Blue!"
Case Else
MsgBox "The text is neither red nor blue"
End Select
End Sub

[tunam8]

Sorry for the slow response. Iv been away from the office...

Im creating a macro that will stop me from sending the mail if I haven't deleted some of the editable fields in the premade templates. These fields are coloured as seen below. I seems to work fine when I compose a new mail but if I work on a forwarded message or if the text is prepopulated into the compose field it doesnt seem to work. I triple checked the RGB codes and that doesnt seem to the problem. The last piece of the code checks that I have attached something if I used the word attached.




Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim objInsp As Inspector
Dim objWord As Object
Dim objDoc As Object
Dim objSel As Object
If Item.Class = olMail Then
Set objInsp = Item.GetInspector
If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
End If
End If
Select Case objSel.Font.Color
Case RGB(204, 0, 255) 'purple text
answer = MsgBox("purple text found, send anway?", vbYesNo)
If answer = vbNo Then Cancel = True

Case RGB(204, 0, 255) ' pink text
answer = MsgBox("pink text found, send anway?", vbYesNo)
If answer = vbNo Then Cancel = True

Case RGB(0, 51, 153) ' delete if applicable blue text
answer = MsgBox("blue text found, send anway?", vbYesNo)
If answer = vbNo Then Cancel = True


End Select

If InStr(1, Item.Body, "attached", vbTextCompare) > 0 Then
If Item.Attachments.Count = 0 Then
answer = MsgBox("There's no attachment, send anyway?", vbYesNo)
If answer = vbNo Then Cancel = True
End If
End If


End Sub

[skatonni]

Verify the selection and the associated RGB.


Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, cancel As Boolean)

Dim objInsp As Inspector
Dim objWord As Object
Dim objDoc As Object
Dim objSel As Object

Dim answer As VbMsgBoxResult

If Item.Class = olMail Then

Set objInsp = Item.GetInspector

If objInsp.EditorType = olEditorWord Then
Set objDoc = objInsp.WordEditor
Set objWord = objDoc.Application
Set objSel = objWord.Selection
End If

End If

Debug.Print
Debug.Print "objSel: " & objSel
Debug.Print "RGB: " & getRGB2(objSel)

Select Case objSel.Font.Color

Case RGB(204, 0, 255) 'purple text
answer = MsgBox("purple text found, send anway?", vbYesNo)
If answer = vbNo Then cancel = True

Case RGB(204, 0, 255) ' pink text - same as purple?
answer = MsgBox("pink text found, send anway?", vbYesNo)
If answer = vbNo Then cancel = True

Case RGB(0, 51, 153) ' delete if applicable blue text
answer = MsgBox("blue text found, send anway?", vbYesNo)
If answer = vbNo Then cancel = True

End Select

If InStr(1, Item.body, "attached", vbTextCompare) > 0 Then
If Item.Attachments.count = 0 Then
answer = MsgBox("There's no attachment, send anyway?", vbYesNo)
If answer = vbNo Then cancel = True
End If
End If

ExitRoutine:
Set objInsp = Nothing
Set objDoc = Nothing
Set objWord = Nothing
Set objSel = Nothing

End Sub

' http://excelribbon.tips.net/T010180_Determining_the_RGB_Value_of_a_Color.html

Function getRGB2(sel) As String

Dim C As Long
Dim R As Long
Dim G As Long
Dim B As Long

C = sel.Font.Color
R = C Mod 256
G = C \ 256 Mod 256
B = C \ 65536 Mod 256

getRGB2 = "R=" & R & ", G=" & G & ", B=" & B

End Function

[tunam8]

So its seems I have to have all the text highlighted before sending for the macro to actually check the font colour.

So is there a way to automatically select all before sending?

[tunam8]

So I've been bashing my head against a wall here.

The code wont detect that the colour is present in the email body if there is more than one colour in the text.

So In other words I want the code to stop me from sending an email if I havent removed all the purple text in body. So right now it is only stopping me if ALL the text is RGB(204, 0, 255) .

Any advice?


Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim oDoc As Object
Dim oRng As Object
Dim answer As VbMsgBoxResult


Set oDoc = ActiveInspector.WordEditor.Application.ActiveDocument
Set oRng = oDoc.Range
oRng.Select




Select Case oRng.Font.Color

Case RGB(204, 0, 255) 'pink text
answer = MsgBox("Colour Text Found, please complete editing", vbYesNo)
If answer = vbNo Then Cancel = True

End Select

End Sub

[gmayor]

If you want to check if the text colour is anywhere in the message body then

Option Explicit

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olInsp As Inspector
Dim oDoc As Object
Dim oRng As Object
Dim answer As Long
With Item
Set olInsp = .GetInspector
Set oDoc = olInsp.WordEditor
Set oRng = oDoc.Range
With oRng.Find
.Font.Color = RGB(204, 0, 255)
Do While .Execute
answer = MsgBox("Colour Text Found. Cancel Sending?", vbYesNo)
If answer = vbYes Then Cancel = True
Exit Do
Loop
End With
End With
lbl_Exit:
Set oDoc = Nothing
Set olInsp = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[tunam8]

Works perfectly, I couldnt figure how to loop in outlook by words
gmayor your a life saver!
Is there anyway to add rep

[tunam8]

Thanks so much for the help in this topic. I was wondering how to have the same idea but based on a font and font size.

So basically an if statement that loops through each word that checks that the font is "Arial" and the size is 10.