How to send emails from excel vba (with attachment) using outlook

Hi there,

I have not done any vba coding before and would like to shout out to the kind souls out there who are willing to share the VBA codes with me..

Below are what I would like to see in the email automation:

- Sheet 1: for me to enter all the email addresses i wanna Bcc to and their names in two columns
* i just want to send to an email address and Bcc to the rest of the contacts..

Sheet 2: for typing out the email subject line, body message and who i wanna send to/ cc/bcc etc.
* as i type in the cells, the coding will be updated too

- As i add in another new email contact, the coding will also be updated

- i want to attach the same attachment for all the email contacts

- a 'send email' button to be created in 'Sheet 2' and upon clicking, it opens up the outlook box and i can proceed to send via outlook

Really hope someone could show me the codes for the above, greatly appreciate all help! :)

Hi finding_dory,

Welcome to ExcelFox

Did you try using this

Quote:

---

Originally Posted by Excel Fox

Hi finding_dory,

Welcome to ExcelFox

Did you try using this

---

Hey Excel Fox, thanks for the reply! I used the below codes but it doesnt attach any files to my email.. could you provide me with codes that command for file attachment and where in my codes should i insert them? Thank you once again!

VBA Code I used:

Code:

---

Private Sub CommandButton2_Click()

Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Recipient As String
Dim Msg As String
Dim objOutlookAttach As Outlook.Attachment

'Create Outlook object
Set OutlookApp = New Outlook.Application

'Loop through the rows
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr1 = EmailAddr1 & ";" & cell.Value
End If
Next

For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr2 = EmailAddr2 & ";" & cell.Value
End If
Next

For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeVisible)
If cell.Value Like "*@*" Then
EmailAddr3 = EmailAddr3 & ";" & cell.Value
End If
Next

'Create Mail Item and view before sending
Set MItem = OutlookApp.CreateItem(olMailItem)
With MItem
.To = EmailAddr2
.BCC = EmailAddr1
.CC = EmailAddr3
.Subject = Sheet2.Cells(5, 2).Value
.Body = Sheet2.Cells(7, 2).Value
.Display
End With

End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

i have tried diffrent codes for this in VBA . what if the attachement or attachements are located in a shared drive?