PDA

View Full Version : sending email with multiple attachments



sunjo
04-02-2018, 01:30 AM
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
04-02-2018, 01:51 AM
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
04-03-2018, 03:38 PM
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. : pray2:

sunjo
04-03-2018, 03:38 PM
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
04-03-2018, 09:18 PM
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