Attaching multiple files that contain certain text

I'm very much a novice to VBA and any help is very much appreciated.

I need to send each client every month a couple of documents for that month (could be anywhere from 0 to 5 documents usually). Every month a new folder is created and all the files for all clients start getting kept in there, in the beginning of the following month we need to send all of these to each client.

I was able to put together a spreadsheet where the outlook application can parse everything out (to, CC, subject, body) and generate emails personalized to each client but I'm having issues finding the logic where it will go into the folder mentioned in column G and find all the files that contain a company's name which is in column A. The folder in column G will be updated automatically every month since the folder changes so no worries in having the right path in there.

Below is my script where I was just attaching a single file and had the full path to the file in column G, where as now I want to have it just go into the folder level and find all the files that have each company's name in there.:

Sub SendEmail(what_address As String, carbon_copy As String, subject_line As String, mail_body As String, Attachments As String)
Dim olApp As Outlook.Application
Dim myMail As Outlook.MailItem
Set olApp = CreateObject("Outlook.Application")

Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)

olMail.To = what_address
olMail.CC = carbon_copy
olMail.Subject = subject_line
olMail.Body = mail_body

olMail.Attachments.Add Attachments

olMail.Display

End Sub


Sub SendMassEmail()

row_number = 1

Do
DoEvents
row_number = row_number + 1

Call SendEmail(Sheet1.Range("B" & row_number), Sheet1.Range("C" & row_number), Sheet1.Range("E" & row_number), Sheet1.Range("F" & row_number), Sheet1.Range("G" & row_number))

Loop While Sheet1.Range("A" & row_number) <> ""

End Sub

If Column G of your worksheet contains a folder location, then what are the 'documents' that are in that folder? Are they workbooks, in which case where does the code need to look for the company name i.e. sheet name and column. If they are Word documents, where in the documents would the macro look for the company name? If they are some other type of 'document', please be more specific.

The principles involved are easy enough. You would loop through the 'documents' and look for the string. If found add the folder and filename to a Collection. Then when all have been searched, add the members of the collection as attachments.

Quote:

---

Originally Posted by gmayor

If Column G of your worksheet contains a folder location, then what are the 'documents' that are in that folder? Are they workbooks, in which case where does the code need to look for the company name i.e. sheet name and column. If they are Word documents, where in the documents would the macro look for the company name? If they are some other type of 'document', please be more specific.

The principles involved are easy enough. You would loop through the 'documents' and look for the string. If found add the folder and filename to a Collection. Then when all have been searched, add the members of the collection as attachments.

---

so they can be pdf files or xlsx files. But each company's file will have their name somewhere in the name of the file:

example:
TESLA receipt oct-2019.pdf
TOYOTA receipt oct-2019.pdf
TESLA invoices oct-2019.xlsx
TOYOTA invoices oct-2019.xlsx
HONDA report oct-2019.pdf

I'm assuming that a wildcard would be used point to the value in column A to complete the folder path that is in column G, example
Path: sheet1.range("G" & row_number).value & "*" sheet1.range("A" & row_number).value "*" ???? (as you can see I'm lost)
maybe loop until all files that contain that text are attached.

let me know if there are any questions

If the company name is in the filename, it is simpler than I anticipated. The following is untested with your data, but it will work if that data is as described. Column D appears to be unused?

Note that the code uses the function from http://www.rondebruin.nl/win/s1/outlook/openclose.htm to open or grab Outlook correctly. You don't want to be creating new Outlook instances for each message, and you need to open it correctly to edit the message body, which method used retains the default signature associated with the account.

The code checks that the folder exists and uses a different method to loop through the data as yours leaves an empty message open.

The code leaves all the messages open unless you re-activate .Send, so test with a smaller data set e.g. make LastRow = 4

Code:

---

Option Explicit

Sub SendMassEmail()
Dim lastRow As Long
Dim row_number As Long
    With Sheet1
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        For row_number = 2 To lastRow
            Call SendEmail(.Range("B" & row_number), _
                          .Range("C" & row_number), _
                          .Range("E" & row_number), _
                          .Range("F" & row_number), _
                          .Range("G" & row_number), _
                          .Range("A" & row_number))
            DoEvents
        Next row_number
    End With
End Sub


Sub SendEmail(what_address As String, _
              carbon_copy As String, _
              subject_line As String, _
              mail_body As String, _
              strPath As String, _
              strCompany As String)


Dim olApp As Object    '- Requires the code from 'http://www.rondebruin.nl/win/s1/outlook/openclose.htm
Dim olMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim strFile As String


    Set olApp = OutlookApp()
    Set olMail = olApp.CreateItem(0)


    With olMail
        .To = what_address
        .CC = carbon_copy
        .Subject = subject_line
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor    'access the message body for editing
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        .Display
        oRng.Text = mail_body
        Do Until Right(strPath, 1) = "\"
            strPath = strPath & "\"
        Loop


        If FolderExists(strPath) = True Then
            strFile = Dir$(strPath & "*.*")
            While strFile <> ""
                If InStr(1, strFile, UCase(strCompany)) > 0 Then
                    .Attachments.Add strPath & strFile
                End If
                DoEvents
                strFile = Dir$()
            Wend
          ' .Send 'after testing
        Else
            MsgBox strPath & " does not exist!"
        End If
    End With
    Set olApp = Nothing
    Set olMail = Nothing
End Sub


Private Function FolderExists(strFolderName As String) As Boolean
'Graham Mayor
'strFolderName is the name of folder to check
Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If (FSO.FolderExists(strFolderName)) Then
        FolderExists = True
    Else
        FolderExists = False
    End If
lbl_Exit:
    Set FSO = Nothing
    Exit Function
End Function

---

Quote:

---

Originally Posted by gmayor

x
[/CODE]

---

Hi Graham,

Thank you so much for looking into this, the code was much more extensive and complex than I'd thought, so thanks.

I would like to clarify exactly what piece of code I need to add from the rondebruin link and where to place it in your code. Right now I'm getting the Sub or Function not defined error while running your code. I'm also attaching a sample of my spreadsheet as it currently exists. Column "D" returns the previous month "=EOMONTH(TODAY(),-1)" whose value is concatenated into columns "E" and "G".

The error is caused by the missing code function. You need the code in blue below the sub-heading 'Test the code', from the link, in a separate module accessible from your worksheet.
Your worksheet extract confirms what I imagined :)