I found this code to send bulk emails to multiple recipients by Outlook with Excel VBA.
What should I add to it to send two attachments not one?
Sub Send_Multiple_Email()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet3")
Dim oa As Object
Dim msg As Object
Set oa = CreateObject("outlook.Application")
Dim i As Integer
Dim last_row As Integer
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
For i = 2 To last_row
Set msg = oa.createitem(0)
msg.to = sh.Range("A" & i).Value
msg.Subject = sh.Range("B" & i).Value
msg.body = sh.Range("c" & i).Value
If sh.Range("D" & i).Value <> "" Then
msg.attachments.Add sh.Range("D" & i).Value
End If
msg.display
Next i
MsgBox "mails sent"
End Sub
Add information to E2 till the end row and add there what you want to attach like , what is done with D.
And you can add more columns f G H I J K .. with more attachments
If the cell is empty, no attachment is added
If sh.Range("D" & i).Value <> "" Then
msg.attachments.Add sh.Range("D" & i).Value
End If
If sh.Range("E" & i).Value <> "" Then
msg.attachments.Add sh.Range("E" & i).Value
End If
msg.display
Related
I have made a code in excel which creates a mail using excel envelop. But this code creates a new email, instead, I want to reply to a particular mail which is saved in path ("C:\Users\dell\Desktop\me\Untitled (1).msg" ) so i want to write the mentioned path in cell in the excel file . Where should I make changes in my code? Please Help!!
Option Explicit
Sub Send_Mails()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Send_Mails")
Dim i As Integer
Dim OA As Object
Dim msg As Object
Set OA = CreateObject("outlook.application")
Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))
For i = 2 To last_row
Set msg = OA.CreateItem(0)
msg.to = sh.Range("A" & i).Value
msg.cc = sh.Range("B" & i).Value
msg.Subject = sh.Range("C" & i).Value
msg.body = sh.Range("D" & i).Value
If sh.Range("E" & i).Value <> "" Then
msg.attachments.Add sh.Range("E" & i).Value
End If
msg.Send
sh.Range("F" & i).Value = "Sent"
Next i
MsgBox "All the mails have been sent successfully"
End Sub
I can not get Excel to see row three as a separate line of data. My code is adding all the attachments from row three to the email with information generated from row two.
How can I loop through rows 2 to the last row with data?
I am trying to send an email using the information filled in each cell of each row. I am using this current code since it is the only way I can get a signature line to work.
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim I As Integer
Dim last_row As Integer
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
last_row = Application.WorksheetFunction.CountA(sh.Range("A:A"))
For I = 2 To last_row
.display
.SentOnBehalfOfName = sh.Range("A" & I).Value
.To = sh.Range("B" & I).Value
.CC = sh.Range("C" & I).Value
.Subject = sh.Range("D" & I).Value
.HTMLBody = strbody & "<br>" & .HTMLBody
If sh.Range("F" & I).Value <> "" Then
.attachments.Add sh.Range("F" & I).Value
End If
If sh.Range("G" & I).Value <> "" Then
.attachments.Add sh.Range("G" & I).Value
End If
If sh.Range("H" & I).Value <> "" Then
.attachments.Add sh.Range("H" & I).Value
End If
I don't think the last part of the code is worth much it is just strbody =. I originally wanted the body to be a variable. That presented the problem of not being able to use a signature line.
I think what you had in mind was perhaps as shown below. The code creates an email text, including some snippets from the worksheet, which can then be assigned to the HTMLbody.
Dim Txt As String
Dim Line As String
Dim C As Long
Txt = "Dear Sir," & vbNewLine & vbNewLine & _
"Please take note of the following." & vbNewLine
Line = ""
For C = 6 To 8
With sh.Cells(i, C)
If Len(.Value) Then
If Len(Line) Then Line = Line & ", "
Line = Line & .Value
End If
End With
Next C
If Len(Line) Then Txt = Txt & Line & vbNewLine
Txt = Txt & "Please get back to me ASAP." & vbNewLine & vbNewLine
Txt = Txt & " Regards" & vbNewLine & "John Doe"
Trying to send emails using VBA however it keeps sending from my personal email address despite best efforts. Please can someone advise how to send from secondary email address?
Sub Send_Mail()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Send_Mail")
Dim I As Integer
Dim OA As Object
Dim msg As Object
Set OA = CreateObject("outlook.application")
Set OutAccount = OA.Session.Accounts.Item(2)
Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))
For I = 2 To last_row
Set msg = OA.CreateItem(0)
msg.SendUsingAccount = OutAccount
msg.To = sh.Range("B" & I).Value
msg.cc = sh.Range("D" & I).Value
msg.Subject = sh.Range("E" & I).Value
msg.body = sh.Range("F" & I).Value
If sh.Range("G" & I).Value <> "" Then
msg.attachments.Add sh.Range("G" & I).Value
End If
msg.send
sh.Range("H" & I).Value = "Sent"
Next I
MsgBox "All emails sent successfully"
End Sub
Thank you!
You can use .From to set the email account that you want to send it from.
strFrom = Name & "<" & Email & ">"
msg.From = strFrom
I am trying to add two attachments to an email.
Below is the code I'm using.
My msgbox pops up saying emails sent but the attachments are not attaching.
The paths where I identify where the files live are in columns F & G.
Sub Send_Multiple_Emails_Match45()
Dim sh As Worksheet, Issent As Boolean, i As Long, last_row As Long
Set sh = ThisWorkbook.Sheets("Match 45 Vendors Emails")
Dim OA As Object
Dim msg As Object
Set OA = CreateObject("Outlook.Application")
last_row = sh.Range("B" & Rows.Count).End(xlUp).Row
For i = 4 To last_row
Set msg = OA.createitem(0)
msg.To = sh.Range("B" & i).Value
msg.cc = sh.Range("C" & i).Value
msg.Subject = sh.Range("D" & i).Value
msg.body = sh.Range("E" & i).Value
If sh.Range("F" & "G" & i).Value <> "" Then
If Dir(sh.Range("F" & "G" & i).Value) <> "" Then
msg.Attachments.Add sh.Range("F" & "G" & i).Value
Else
Range("H" & i).Value = "Wrong attachment path"
GoTo NextMail
End If
End If
On Error Resume Next
msg.send
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Issent = False
Else
On Error GoTo 0
Issent = True
End If
If Issent = True Then
Range("H" & i).Value = "Sent"
Else
Range("H" & i).Value = "Not Sent"
End If
NextMail:
Set msg = Nothing
Next i
MsgBox "Mails Sent"
End Sub
"F:G" & i is incorrect. You need to specify the row for both F and G. The code will not concatenate the two value for you. It would be best to add a helper variable for the filename. This will help make it easier to test your code.
Hi Guys i solve this by adding additional if condition for another attachment. below is my code for you. Enjoy the code
Sub Send_Mails()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Send_Mails")
Dim i As Integer
Dim OA As Object
Dim msg As Object
Set OA = CreateObject("outlook.application")
Dim last_row As Integer
last_row = Application.CountA(sh.Range("A:A"))
For i = 2 To last_row
Set msg = OA.createitem(0)
msg.to = sh.Range("A" & i).Value
msg.cc = sh.Range("B" & i).Value
msg.Subject = sh.Range("C" & i).Value
msg.body = sh.Range("D" & i).Value
If sh.Range("E" & i).Value <> "" Then
msg.attachments.Add sh.Range("E" & i).Value
End If
If sh.Range("F" & i).Value <> "" Then
msg.attachments.Add sh.Range("F" & i).Value
End If
msg.send
sh.Range("g" & i).Value = "Sent"
Next i
MsgBox "All the mails have been sent successfully, Thank u Syed"
End Sub
I figured out the problem, in case in the future anyone needs help with this. This is the updated code where it attaches two files and tells me if each attachment was sent or not sent or there was a wrong path.
Dim sh As Worksheet, Issent As Boolean, i As Long, last_row As Long
Set sh = ThisWorkbook.Sheets("Match 45 Vendors Emails")
Dim OA As Object
Dim msg As Object
Dim rngAttach1 As Range
Dim rngAttach2 As Range
Set OA = CreateObject("Outlook.Application")
last_row = sh.Range("B" & Rows.Count).End(xlUp).Row
Set rngAttach1 = sh.Range("F:F")
Set rngAttach2 = sh.Range("G:G")
For i = 4 To last_row
Set msg = OA.createitem(0)
msg.To = sh.Range("B" & i).Value
msg.cc = sh.Range("C" & i).Value
msg.Subject = sh.Range("D" & i).Value
msg.body = sh.Range("E" & i).Value
If rngAttach1(i).Value <> "" Then
If Dir(rngAttach1(i).Value) <> "" Then
msg.Attachments.Add rngAttach1(i).Value
Else
Range("H" & i).Value = "Wrong attachment path"
GoTo NextMail
End If
End If
If rngAttach2(i).Value <> "" Then
If Dir(rngAttach2(i).Value) <> "" Then
Attachments.Add rngAttach2(i).Value
Else
Range("I" & i).Value = "Wrong attachment path"
GoTo NextMail
End If
End If
On Error Resume Next
msg.send
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Issent = False
Else
On Error GoTo 0
Issent = True
End If
If Issent = True Then
Range("H" & i).Value = "Sent"
Else
Range("H" & i).Value = "Not Sent"
End If
If Issent = True Then
Range("I" & i).Value = "Sent"
Else
Range("I" & i).Value = "Not Sent"
End If
NextMail:
Set msg = Nothing
Next i
MsgBox "Mails Sent"
End Sub
I'm using the below code to tell me when emails have been sent and display the text "sent" so I know there were no errors. But I was testing the code and I use a vlookup to display emails once I add the vendor name. My goal is to not let the macro debug and to let it keep going on to the next but at the same time let me know there was an error on one row either because that vendor did not have an email listed and I need to fill an email in. When I listed the vendors I left a cell blank to test code. Even tho I have valid emails and those emails sent the VBA displays "Not sent" to the ones that were sent out. Since the macro could not find an email due to one cell being blank it debugged and next to all the valid emails the text "Not sent" populates. What am I missing or doing wrong? I just want to avoid debugs to tell me there is an error and just tell me that one row was "not sent" and to just keep sending the rest and populate those that do send with a "sent" text.
Sub Send_Multiple_Emails()
dim sh as worksheet
set sh = thisworkbook.sheets("sheet1") <-- rename to what the tabs name is
dim OA as Object
Dim msg As object
set OA = createobject("Outlook.Application")
Dim i as integer
dim last_row As Integer
last_row = application.worksheetfunction.counta(sh.range("B:B"))
for i = 2 To last_row
Set msg = OA.createitem(0)
msg.to = sh.Range("B" & i).Value
msg.cc = sh.Range("C" & i).Value
msg.subject = sh.range("D" & i ).Value
msg.body = sh.Range("E" & i).Value
if sh.Range("F" & i).Value <> "" Then
msg.attachments.add sh.range("F" & i).Value
End If
msg.send
**If Issent = True Then
Range("G" & i).Value = "Sent"
Else
Range("G" & i).Value = "Not Sent"
End If**
next i
msgbox "Mails Sent"
End Sub
Try replacing of this code part, please:
msg.send
If Issent = True Then
Range("G" & i).Value = "Sent"
Else
Range("G" & i).Value = "Not Sent"
End If
with this one:
Dim Issent As Boolean
On Error Resume Next
msg.send
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Issent = False
Else
On Error GoTo 0
Issent = True
End If
If Issent = True Then
Range("G" & i).Value = "Sent"
Else
Range("G" & i).Value = "Not Sent"
End If
Edited:
I do not think that the above inserted lines can bother your code smooth operation. Even if not this was the question, please try the next adapted code. It also deals with eventual wrong paths to documents to be attached:
Add a reference to Microsoft Outlook ... Object Library. Being in VBE (Visual Basic Editor), go: Tools (menu) -> References... Scroll down until you find the above mentioned reference. Check it and press OK.
Copy the next code instead of yours, or near it (I will change the Sub name) and run it:
Sub Send_Multiple_Emails_bis()
Dim sh As Worksheet, Issent As Boolean, i As Long, last_row As Long
Dim OA As New Outlook.Application, msg As Outlook.MailItem
Set sh = ActiveSheet ' ThisWorkbook.Sheets("sheet1")
last_row = sh.Range("B" & Rows.count).End(xlUp).row
For i = 2 To last_row
Set msg = OA.CreateItem(0)
With msg
.To = sh.Range("B" & i).Value
.cc = sh.Range("C" & i).Value
.Subject = sh.Range("D" & i).Value
.body = sh.Range("E" & i).Value
'.display 'un-comment if you want to see each mail sending window
End With
If sh.Range("F" & i).Value <> "" Then
If Dir(sh.Range("F" & i).Value) <> "" Then
msg.Attachments.aDD sh.Range("F" & i).Value
Else
Range("G" & i).Value = "Wrong attachment path"
GoTo NextMail
End If
End If
On Error Resume Next
msg.send
If Err.Number <> 0 Then
Err.Clear: On Error GoTo 0
Issent = False
Else
On Error GoTo 0
Issent = True
End If
If Issent = True Then
Range("G" & i).Value = "Sent"
Else
Range("G" & i).Value = "Not Sent"
End If
NextMail:
Set msg = Nothing
Next i
MsgBox "Mails Sent"
End Sub
I would like to receive some feedback regarding its behavior...