Search Outlook attachments for specific content before sending new e-mail

[Vin_Ramdeen]

Hi All,

I have a VBA macro in Excel which searches through an Excel workbook to check whether or not a specific department is present in the workbook. The macro searches along the header row of the first worksheet, looks for the "Department" column header and then searches down this column to see if a specified department(s) is found. If the department(s) is not present in the worksheet, the macro moves on to the next worksheet and repeats the process until all worksheets have been checked.

If the department(s) are not present in the workbook, the macro ends and nothing further happens. However, if the department(s) are present in the workbook, in any of the worksheets, under any of the "Department" columns, a message box pops up with a warning letting the user know that they are present and vbYesNo asks if the user would like to continue.

The macro is a subroutine I would like to implement when the user is sending e-mails with Excel attachments via Outlook. As an error-checking stage, I would like to use the Outlook ItemSend event when the "Send" button is pressed to search the e-mail for Excel attachments, and if present, run the code which searches the Excel files attached. If the specified department(s) is present in the file, I would like a warning/prompt to pop-up asking the user if they would like to continue sending the e-mail or not. If yes, the Outlook send event continues and the e-mail is sent. If no, the Outlook send event is terminated and the user can then decide what to do next.

From scouring the Internet, I have found code which checks if attachments have been included, opens attachments, saves attachments, and even sends the attachments to specific locations when e-mails are received, but have yet to find anything that checks attachment content prior to sending. Your help would be greatly appreciated.

Cheers,

Vin

[Vin_Ramdeen]

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

[mancubus]

welcome to the forum.

it seems you need Outlook macro and this is Excel Help forum.
ask one of the forum moderators (samT or AussieBear) to move this thread to Outlook help forum.

that said, the code in this thread may help you.
http://www.vbaexpress.com/forum/showthread.php?6653-Solved-Open-attachment-in-Outlook-MailItem-with-VBA