Consulting

Results 1 to 3 of 3

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

  1. #1
    VBAX Newbie
    Joined
    Nov 2015
    Location
    London
    Posts
    2
    Location

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

    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

  2. #2
    VBAX Newbie
    Joined
    Nov 2015
    Location
    London
    Posts
    2
    Location
    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

  3. #3
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    Ride the wind to the sun
    Posts
    2,598
    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/show...lItem-with-VBA
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

Tags for this Thread

Posting Permissions

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