Macro to search for file name in a folder and attach it to email from Excel

[phanc70846]

Hello Experts!

I have some code I have cobbled together where I am trying to email a unique Excel file to individuals on a distribution list based on a value in an Excel column. Everything is working well except searching for the Excel file with part of the name and attaching the Excel file to the email.

Our accounting reporting system automatically creates new income statement Excel files for each department every day and saves them to a folder. I need to send these files to different department owners each day. The problem is the reporting system gives the files a unique name each day. One part of the file name is always constant. What I am trying to do is via Excel macro search in the folder for that part of the name that is constant (listed in an Excel column) and, once found, attach it to an email. The new file created each day always has a common element like "200D970" which is part of the file name each day. What I am trying to do is have the Excel macro search for that specific element from an Excel column ("200D970") within the full name of the file ("COSTCTR_200D970_PRESIDENT - CEO_20152710085409.xls") and if it finds a match attaches it to an email. The common element ("200D970") will always be in the same row as the email address, person's name email is being sent to, etc.

My spreadsheet has the following:

• Column "V" has the folder location where the file is saved
• Column I contains a list of the constant file name values ("200D970" "200D971" "200D972", etc.) (the unique file name each day will include this value as part of the full file name).

Below is the code I have so far. Everything is working well except searching for and attaching the Excel file to the email based on a search of the file name element ("200D970"):

CODE
Sub Send_Email()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")


On Error GoTo cleanup
For Each cell In Columns("N").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "Q").Value) = "yes" _
Then


Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail
.To = cell.Value
.CC = Cells(cell.Row, "O").Value
'.BCC =
' The Subject is cell S2 + whatever is in column J on the same row
.Subject = Worksheets("OH List").Range("S2") & " - " & Cells(cell.Row, "J").Value
.Body = "Dear " & Cells(cell.Row, "M").Value _
& vbNewLine & vbNewLine & _
Range("T2").Value & " for cost center " & Cells(cell.Row, "I").Value & " - " & Cells(cell.Row, "J").Value _
& vbNewLine & vbNewLine & _
"Best regards, " & _
vbNewLine & _
"John Doe"
.Attachments.Add Cells(cell.Row, "X").Value
.Display
End With
Set OutMail = Nothing
End If
Next cell


cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
CODE


Thank you in advance for any help you can provide!!

Thanks,
Philip