VBA to send emails attachment base on path (folder)

H

harky

Active Member
Joined
Apr 8, 2010
Messages
405
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
ABCDEF
S/NTo:ccSubjectBodyPath of Attachment folder
1abc@email1.comabc@email1.comtest email 1Hello EmailC:\Users\ABC\Desktop\SavedFolder\Folder1

<tbody>
</tbody>

I had a code below, possible to attach a code which will attach any file tht found in Path of Attachment folder?
If no folder or nth in the folder, it will be ignored.



Code: 
Sub SendEmail()


'START of confirmation message box'
    response = MsgBox("Start sending email?", vbYesNo)
    If response = vbNo Then
    MsgBox ("Macro Canceled!")
    Exit Sub
    End If
'END of confirmation message box'


Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
Dim wks As Worksheet


lr = Cells(Rows.Count, "B").End(xlUp).Row


Set Mail_Object = CreateObject("Outlook.Application")
Set wks = Worksheets("send_email")


For i = 2 To lr
        With Mail_Object.CreateItem(o)
            .To = wks.Range("B" & i).Value
            .CC = wks.Range("C" & i).Value
            .Subject = wks.Range("D" & i).Value
            .Body = wks.Range("E" & i).Value
            .Send
            '.display 'disable display and enable send to send automatically
            Application.Wait (Now + TimeValue("0:00:03")) 'Pausing an application for 3s, before next email
    End With
Next i
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing
End Sub
 
Last edited:
Sort by date Sort by votes
DanteAmor said:
I don't know that function. I suggest you create a new thread, we hope someone helps you.
Click to expand...
Hi, hope u doing well..
i still using this but can help me hehe

I want to change the path which is column H to something like this, so i can embedded Image in message body and hidden the jpg/png from the folder @ column H
.Attachments.Add "C:\Users\Sumit Jain\Pictures\11\city.jpg", olByValue, 0

VBA Code: 
    Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long, d As Long
    Dim wks As Worksheet, pf As String, wPath As String, wFile As Variant, wPattern As String
    Dim num_err As Variant, sErr As Boolean


    'START of confirmation message box'
    response = MsgBox("Start sending email?", vbYesNo)
    If response = vbNo Then
        MsgBox ("Macro Canceled!")
        Exit Sub
    End If
    'END of confirmation message box'
    
    
    Set Mail_Object = CreateObject("Outlook.Application")
    Set wks = Worksheets("SendEmail")
    lr = wks.Cells(Rows.Count, "B").End(xlUp).Row
    For i = 2 To lr
        sErr = False
        With Mail_Object.CreateItem(o)
            .to = wks.Range("B" & i).Value
  '         .cc = wks.Range("C" & i).Value
            .bcc = wks.Range("C" & i).Value
            .Subject = wks.Range("D" & i).Value
            .HTMLBody = wks.Range("E" & i).Value & vbNewLine & _
             wks.Range("F" & i).Value & vbNewLine & _
             wks.Range("G" & i).Value

   '         "<HTML><BODY><span style=""color:#80BFFF"">Font Color</span style=""color:#80BFFF""> <br>the <b>bold text</b> here.</br> <br><u>New line with underline</u></br><br><p style='font-family:calibri;font-size:25'>Font size</br></p></BODY></HTML>"
  '          .Body = wks.Range("E" & i).Value & vbNewLine & _
                wks.Range("F" & i).Value & vbNewLine & _
                wks.Range("G" & i).Value
            
            pf = wks.Range("H" & i).Value
            d = InStrRev(pf, "\")
            wPath = Left(pf, d)
            wPattern = Mid(pf, d + 1)
            If wPath <> "" Then
                If wPattern = "" Then wPattern = "*.*"
                'If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
                If Dir(wPath, vbDirectory) <> "" Then
                    wFile = Dir(wPath & wPattern)
                    On Error Resume Next
                    If wFile <> "" Then
                        Do While wFile <> ""
                            .Attachments.Add wPath & wFile
                            num_error = Err.Number
                            If num_error <> 0 Then
                                wks.Range("I" & i).Value = "ERROR Exceed Size"
                                sErr = True
                            End If
                            wFile = Dir()
                        Loop
                    Else
                        wks.Range("I" & i).Value = "ERROR Wrong File URL"
                        sErr = True
                    End If
                    On Error GoTo 0
                Else
                    wks.Range("I" & i).Value = "ERROR Wrong Folder URL"
                    sErr = True
                End If
            End If
            If sErr = False Then
                .Send
                '.display 'disable display and enable send to send automatically
                num_error = Err.Number
                If num_error <> 0 Then
                    wks.Range("I" & i).Value = Err.Description
                Else
                    wks.Range("I" & i).Value = "Email Send!"
                End If
            End If
            Application.Wait (Now + TimeValue("0:00:08")) 'Pausing an application for 60s, before next email
        End With
    Next i
    MsgBox "E-mail successfully sent", 64
    Application.DisplayAlerts = False
    Set Mail_Object = Nothing
End Sub
 
Upvote 0

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Hi. this code is great, thank you ser!

however it prepares the emails but doesn't actually send them ... I just have the emails open in outlook waiting for me to click Send.. does anybody else have this?

how can the emails auto-send ?
 
Upvote 0
You must log in or register to reply here.

Similar threads

melodramatic
  • Question
VBA Send Outlook email, Save email to file folder
Replies
3
Views
475
melodramatic
melodramatic
M
  • Question
Excel VBA Save PDF within workbook folder and send as email attachment
Replies
1
Views
229
rpaulson
rpaulson
larinda4
  • Question
VBA: Send Outlook Email & Attach PDF
Replies
1
Views
141
Trebor76
T
J
  • Question
PDF to Email
Replies
6
Views
255
dermie_72
D
J
  • Question
Sending Emails using VBA
Replies
4
Views
542
Micron
M

Forum statistics

Threads
1,215,071
Messages
6,122,964
Members
449,094
Latest member
Anshu121

Share this page

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
Back
Top