Consulting

Results 1 to 6 of 6

Thread: Attaching multiple files that contain certain text

  1. #1

    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

  2. #2
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Quote Originally Posted by gmayor View Post
    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

  4. #4
    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



    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Quote Originally Posted by gmayor View Post
    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".
    Attached Images Attached Images

  6. #6
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

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