sending email with multiple attachments

[sunjo]

Hello,

I was wondering if it is possible to send emails with only the attachments whose names are specified in the cell.

Also, I should be able to send this any user so that they can use it without changing the username in the path. I mean the path should be given as .attachments.add Environ("userprofile") & "\desktop\handbook\filename"


I have attached the file.

[gmayor]

Based on your code, you need something like the following. Either add the extension to the filename or if it is constant, include it in the code as shown below.
The users will of course have to have the files in a 'handbook' folder in their desktops and the macro tests for the files and only creates messages if they exist.
Note that you5 attachment is in column 5 and not column 7.

Option Explicit

Sub sendemail()

Dim olapp As Outlook.Application
Dim olmail As Outlook.MailItem
Dim i As Integer
Dim strPath As String: strPath = Environ("userprofile") & "\desktop\handbook\"
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set olapp = New Outlook.Application
    For i = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        If fso.FileExists(strPath & Cells(i, 5).Value & ".ext") Then
            Set olmail = olapp.CreateItem(olMailItem)
            With olmail
                .To = Cells(i, 1).Value
                .CC = Cells(i, 2).Value
                .Subject = Cells(i, 3).Value
                .Attachments.Add strPath & Cells(i, 5).Value & ".ext"    'where ext is the extension of the file
                .Display
            End With
        Else
Debug.Print strPath & Cells(i, 5).Value & ".ext - does not exist"
        End If
        Set fso = Nothing
        Set olmail = Nothing
        Set olapp = Nothing
    Next
End Sub

[sunjo]

Hello Graham - Thank you for helping me out. But the code isn't working for me.

I need to have 5 emails sent from a worksheet with more than 50 attachments. The workbook would have 77 worksheet with this requirement.

And I want to share this with other people so that they can use it without any need to edit the code to personalize for them.

My code doesn't work - if you could fix this for me please.

[sunjo]

Sub sendemail()


Dim olapp As Outlook.Application
Dim olmail As Outlook.MailItem


For i = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row


Set olapp = New Outlook.Application
Set olmail = olapp.CreateItem(olMailItem)

With olmail
.To = Cells(i, 1).Value
.CC = Cells(i, 2).Value
.Subject = Cells(i, 3).Value
.Attachments.Add Environ("userprofile") & "desktop\ & ActiveSheet.Cells(i, 5).Value"

.Display

End With

Set olmail = Nothing
Set olapp = Nothing
Next

End Sub

[gmayor]

If you want to create an e-mail for each sheet with the attachments from column 5 on those sheets then you need to change the code to loop through all the sheets and then loop through the rows on each sheet for the attachments, but set the other values from the first data row which is common to all.

You also need to determine the last row from the column with the attachments and not from the first column, which only has one row after the header.

Then there is the issue of the folder. While the code is transportable between users, the folder and its contents are not shared. They would each have to have the desktop folder and the files it contains - or put the files in a folder to which all the users have access and change the path to match.

Note the earlier comments abolut the extension.

Sub sendemail()

Dim olapp As Outlook.Application
Dim olmail As Outlook.MailItem
Dim i As Long, j As Long
Dim xlSheet As Worksheet
Dim strPath As String: strPath = Environ("userprofile") & "\desktop\handbook\"
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set olapp = New Outlook.Application
    For j = 1 To ActiveWorkbook.Worksheets.Count
        Set xlSheet = ActiveWorkbook.Sheets(j)
        Set olmail = olapp.CreateItem(olMailItem)
        For i = 2 To xlSheet.Cells(xlSheet.Rows.Count, 5).End(xlUp).Row
            With olmail
                .To = xlSheet.Cells(2, 1).Value
                .CC = xlSheet.Cells(2, 2).Value
                .Subject = xlSheet.Cells(2, 3).Value
                If fso.FileExists(strPath & xlSheet.Cells(i, 5).Value & ".ext") Then
                    .Attachments.Add strPath & xlSheet.Cells(i, 5).Value & ".ext"
                Else
Debug.Print strPath & xlSheet.Cells(i, 5).Value & ".ext - does not exist"
                End If
                .Display
            End With
        Next i
        Set olmail = Nothing
        Set xlSheet = Nothing
    Next j
    Set olapp = Nothing
End Sub