Select Folder> Scan for File (using cell value) and Attach to Email

[StevenAncel]

Here is what im trying to accomplish.

I have a spreadsheet:
[TABLE="width: 500"]
<tbody>[TR]
[TD="align: center"][/TD]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="align: center"]NAME[/TD]
[TD="align: center"]TO:[/TD]
[TD="align: center"]CC:[/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD]Marky Mark[/TD]
[TD]marky@mail.com[/TD]
[TD]other1@mail.com[/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD]John Johnson[/TD]
[TD]john@mail.com[/TD]
[TD]other2@mail.com[/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD]Lucky Leaf[/TD]
[TD]lucky@mail.com[/TD]
[TD]other3@mail.com[/TD]
[/TR]
</tbody>[/TABLE]

​

Example Steps:
1. Run Macro
2. Prompt to select folder
3. For Each Row:
----a. Folder will scan the folder for a file that contains the value in column "A" (ex. Filenamed 'Daily Rep Marky Mark.xlsx')
----b. When file is found, it will generate an email and attach the file, while using column "B" as TO: and "C" as CC:
----c. Then on to the next row, scanning the same folder for the next "A" value (Ex. John Johnson)

 

[lrobbo314]

How about this...

Sub test()
Dim olApp       As Outlook.Application
Dim olMail      As Outlook.MailItem

Dim fld         As FileDialog
Dim FolderPath  As String
Dim sFile       As String
Dim ws          As Worksheet
Dim r           As Range
Dim rNames      As Range
Dim cel         As Range

Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
Set ws = Sheets("Sheet3")
Set r = ws.Range("A1").CurrentRegion
Set rNames = ws.Range("A2", ws.Range("A" & Rows.Count).End(xlUp))

Set fld = Application.FileDialog(msoFileDialogFolderPicker)
fld.Show
FolderPath = fld.SelectedItems(1)

For Each cel In rNames
    Do
        sFile = Dir(FolderPath & "\" & "*.*")
            If Len(InStr(sFile, cel.Value)) > 0 Then
                With olMail
                    .to = cel.Offset(, 1)
                    .cc = cel.Offset(, 2)
                    .Display 'For testing
                    .Send 'Use to actually send
                End With
            End If
        sFile = Dir$
    Loop Until sFile = ""
Next cel

Set olMail = Nothing
Set olApp = Nothing

End Sub

You need to make a reference to the Outlook object library. Go to Tools --> References, then check the Microsoft Outlook Object Library.