Loop through files in folder, email file to listed recipient of file name = cell value

**Groovicles** · 04-04-2017, 12:48 PM

Hi everyone,

I have a number of files in a single folder. Each of these files must be emailed to unique recipients.

In my VBA workbook, sheet DataSheet, column P has the file names (without extension), column Q is the To field, and column R is the CC field.

What I'm trying to do is have a macro which will open file explorer, the user will identify the folder the files are located in, and then loop through each file in the folder. If the file name matches a value in column P, then outlook will send an email with the same file attached to the recipients listed in column Q and R. Below is what I have so far, but I keep getting an error on the Attach.add line.

Sub Email_Reps()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim lastRow As Long
Dim MailDest As String
Dim subj As String


lastRow = ThisWorkbook.Worksheets("DataSheet").Cells(Rows.Count, "P").End(xlUp).Row

With Application.FileDialog(msoFileDialogOpen)
For i = 2 To lastRow

    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)
    Set Attach = OutLookMailItem.Attachments
    
    With OutLookMailItem
        .To = Cells(i, 2).Value
        .cc = Cells(1, 3).Value
        .Subject = "Blah"
        .Body = "BlahBlah"
        Attach.Add Cells(i, 1).Value & ".xlsx"
        .Send
    End With

Next
End With

End Sub

Any ideas?

Thanks!!!

**Bernie Deitrick** · 04-04-2017, 02:45 PM

Try this:

Sub Email_Reps()
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim lngR As Long
    Dim MailDest As String
    Dim Attach As Object
    Dim subj As String
    Dim shD As Worksheet
    Dim strPath As String
    Dim strR As String
    Dim oFolder As Variant
    Dim oShell As Variant

    Set shD = ThisWorkbook.Worksheets("DataSheet")
    
    'Chose a folder - Show the dialog
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.BrowseForFolder(0, "Select Folder", 0, "")

    If Not oFolder Is Nothing Then
        strPath = oFolder.Self.Path
    Else
        MsgBox "You cancelled."
        Exit Sub
    End If
    
    Set OutLookApp = CreateObject("Outlook.application")
    
    For lngR = 2 To shD.Cells(shD.Rows.Count, "P").End(xlUp).Row
        strR = Dir(strPath & "\" & shD.Cells(lngR, "P").Value & ".xlsx")
        If strR <> "" Then
            Set OutLookMailItem = OutLookApp.CreateItem(0)
            Set Attach = OutLookMailItem.Attachments

            With OutLookMailItem
                .To = shD.Cells(lngR, "Q").Value
                .cc = shD.Cells(lngR, "R").Value
                .Subject = "Blah"
                .Body = "BlahBlah"
                Attach.Add strPath & "\" & strR
                .Send
            End With
        End If
    Next lngR

End Sub

**Groovicles** · 04-04-2017, 03:41 PM

Perfect. Thank you.

Loop through files in folder, email file to listed recipient of file name = cell value

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Loop through files in folder, email file to listed recipient of file name = cell value

Re: Loop through files in folder, email file to listed recipient of file name = cell value

Re: Loop through files in folder, email file to listed recipient of file name = cell value

Thread Information

Users Browsing this Thread

Similar Threads

Loop Through all files in folder only finding first file

VBA Look Through Folder and Open Files Not Listed in Master File

Loop through files in a folder and copy 2 rows from each file(xlsx) in a master file(xlsx)

[SOLVED] Create hyperlink to file in another folder if listed in column A

Loop through each folder and then loop through each file to find file with certain keyword

How to exctract files listed in an Excel-file from a folder?

[SOLVED] .xls email attachments are arriving at the recipient as .dat file.

Bookmarks

Bookmarks

Posting Permissions