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
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD="align: center"]A[/TD]
[TD="align: center"]B[/TD]
[TD="align: center"]C[/TD]
[TD="align: center"]D[/TD]
[TD="align: center"]E[/TD]
[TD="align: center"]F[/TD]
[/TR]
[TR]
[TD="align: center"]S/N[/TD]
[TD="align: center"]To:[/TD]
[TD="align: center"]cc[/TD]
[TD="align: center"]Subject[/TD]
[TD="align: center"]Body[/TD]
[TD="align: center"]Path of Attachment folder[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]abc@email1.com[/TD]
[TD]abc@email1.com[/TD]
[TD]test email 1[/TD]
[TD]Hello Email[/TD]
[TD]C:\Users\ABC\Desktop\SavedFolder\Folder1[/TD]
[/TR]
</tbody>[/TABLE]

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

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
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

N
  • Question Question
VBA: Automatically send emails in a loop with different attachments
Replies
3
Views
282
cwstudio2020
C
J
  • Question Question
VBA to send multiple emails with multiple attachments
Replies
5
Views
607
6StringJazzer
6StringJazzer
B
  • Solved
VBA to email recipient if column cells contain value
Replies
6
Views
475
bh24524
B
L
  • Question Question
Sending Email with Table in Body
Replies
3
Views
519
Domenic
D
I
  • Question Question
VBA Module to save & Send Active Sheet to List of recipients
Replies
1
Views
325
severynm
severynm

Forum statistics

Threads
1,223,228
Messages
6,170,874
Members
452,363
Latest member
merico17

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