I've managed to get this far with my coding. All that is left is to actually search the Outlook attachments rather than a standalone file on my hard drive. Still having no luck.
Private Sub Application_ItemSend(ByVal Item As Object, ByRef Cancel As Boolean)
Dim xlApp As Excel.Application
Dim xlWbk As Workbook
Set xlApp = New Excel.Application
Set xlWbk = xlApp.Workbooks.Open("C:\My Documents\My_File.xlsm")
xlApp.Visible = True
Dim xlWks As Worksheet
Dim rngFound As Range
Dim WhatToFind As Variant
Dim iCtr As Long
Dim aCell As Range, Rng As Range
Dim col As Long, lRow As Long
Dim colName As String
WhatToFind = Array("Department 1", "Dept. 1", "D1")
For Each xlWks In xlWbk.Worksheets
With xlWks
Set aCell = .Range("A1:XFD1").Find(What:="Department", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
col = aCell.Column
colName = Split(.Cells(, col).Address, "$")(1)
lRow = .Range(colName & .Rows.Count).End(xlUp).Row
Set Rng = .Range(colName & "1:" & colName & lRow)
With xlWks.UsedRange
For iCtr = LBound(WhatToFind) To UBound(WhatToFind)
Set rngFound = .Cells(.Cells.Count)
If xlApp.WorksheetFunction.CountIf(Rng, WhatToFind(iCtr)) > 0 Then
If MsgBox("Your attachment contains Department 1 data" & vbCrLf & "Do you still want to send?", vbExclamation + vbYesNo + vbMsgBoxSetForeground) = vbNo Then
Cancel = True
xlWbk.Close
Exit Sub
End If
End If
Next
End With
End If
End With
Next
xlWbk.Close
End Sub