VBA sending emails through outlook problem.

gd6noob

Board Regular
Joined
Oct 20, 2017
Messages
102
Office Version
  1. 2016
Platform
  1. Windows
Hi guys,

So I have weird issue.
The code I have works and sends to all the Recipients, picks up word doc as body and attaches files. But for some reason, for some people, it sends multiple attachments and for some, only 1 attachment.


VBA Code:
Sub SendMailNoTemplate()

Dim objOutlook As Object, objMail As Object, OutApp As Object, OutMail As Object
Dim ws As Worksheet
Dim cell As Range, FileCell As Range, rng As Range
Dim signature As String
Dim LstRow As Long
Dim oAccount As Outlook.Account
Dim wd As Word.Application
Dim doc As Word.Document


Set objOutlook = CreateObject("Outlook.Application")
Set ws = Sheets("Email")
Set wd = CreateObject("Word.Application")
    wd.Visible = True
Set doc = wd.Documents.Open(Filename:="C:\Users\leonge\Desktop\Email\" & Sheets("Dashboard").Range("G27"), ReadOnly:=True)
    'Copy the open document
    doc.Content.Copy
    doc.Close
    
LstRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

For Each oAccount In Outlook.Application.Session.Accounts

If oAccount = Sheets("Dashboard").Range("G17") Then

    For Each cell In ws.Range("A2:A" & LstRow)
    
        Set objMail = objOutlook.CreateItem(0)
        signature = objMail.Body
            With objMail
            .To = ws.Cells(cell.Row, 1).Value
            .CC = ws.Cells(cell.Row, 2).Value
            .Subject = ws.Cells(cell.Row, 3).Value
'            .Body = rngBody.Value   'commented out to send DOC as body
            .BodyFormat = olFormatRichText
                Set Editor = .GetInspector.WordEditor
                Editor.Content.Paste
                .Display
           
            Set rng = ws.Cells(cell.Row, 1).Range("F1")
            
                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell.Value) <> "" Then
                           If Dir(FileCell.Value) <> "" Then
                                .Attachments.Add FileCell.Value
                           End If
                    End If
                Next FileCell
              
            Set .SendUsingAccount = oAccount
                .Send
            End With
    
        Set objMail = Nothing
    Next cell
    Else
End If

Next

Set wd = Nothing
Set doc = Nothing
Set ws = Nothing
Set objOutlook = Nothing
Set objMail = Nothing
Set wd = Nothing
Set doc = Nothing
Set ws = Nothing
MsgBox "Emails sent"

End Sub

Emailold.xlsb
ABCDEF
1ToCCSubjectNameBodyAttachment
2test@outlook.comtestC:\Users\leonge\Desktop\Email\Attachments\test.pdf
3test@gmail.comEssential Work Letter - For Ontario - Stay at home orderC:\Users\leonge\Desktop\Email\Attachments\test.pdf
Email



So to sum up;
1 - Some Recipients receive more then 1 attachment, if I have 10 Recipients, then a few would receive 10 attachments. if I have 20 Recipients, then a few would receive 20 attachments.
2 - how to hide outlook from showing the email being created?
3 - is there more efficient way to code?
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

daverunt

Well-known Member
Joined
Jul 9, 2009
Messages
1,891
Office Version
  1. 2013
Platform
  1. Windows
Sounds like it is adding an attachment to the same object each time you loop. So each new mail would get previous attachments + 1

You created the objMail inside the loop. Try setting it to Nothing before exiting the loop and creating a new objMail.

Code:
End If
Set objMail = Nothing
Next

Set wd = Nothing
Set doc = Nothing
Set ws = Nothing
Set objOutlook = Nothing
Set wd = Nothing
Set doc = Nothing
Set ws = Nothing
MsgBox "Emails sent"

End Sub

There's always the option to check if there are attachments and remove them before adding the one you want.


As you are copying/pasting from a Word doc to the email body it needs to display the mail to do the pasting.
 
Last edited:

gd6noob

Board Regular
Joined
Oct 20, 2017
Messages
102
Office Version
  1. 2016
Platform
  1. Windows
I tried putting the "Set objMail = Nothing" before the end of loop and still the same issue...
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
I think the following line of code is not giving you the result that you are expecting.
Would recommend to add a debug line so the immediate window shows you what is going on.
VBA Code:
    For Each FileCell In Rng.SpecialCells(xlCellTypeConstants)
Debug.Print FileCell.Address
 

Watch MrExcel Video

Forum statistics

Threads
1,126,957
Messages
5,621,822
Members
415,859
Latest member
Vain

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top