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:

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.
Sort by date Sort by votes
harky said:
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.
Click to expand...

Try this

Code: 
Sub SendEmail()
    Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
    Dim wks As Worksheet, wPath As String, wFile As Variant


    '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'
    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
            wPath = wks.Range("F" & i).Value
            If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
            If Dir(wPath, vbDirectory) <> "" Then
                wFile = Dir(wPath & "*.*")
                Do While wFile <> ""
                    .Attachments.Add wPath & wFile
                    wFile = Dir()
                Loop
            End If
            .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
 
Upvote 0
Thanks! this works great.. thanks pal!

DanteAmor said:
Try this

Code: 
Sub SendEmail()
    Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
    Dim wks As Worksheet, wPath As String, wFile As Variant


    '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'
    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
            wPath = wks.Range("F" & i).Value
            If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
            If Dir(wPath, vbDirectory) <> "" Then
                wFile = Dir(wPath & "*.*")
                Do While wFile <> ""
                    .Attachments.Add wPath & wFile
                    wFile = Dir()
                Loop
            End If
            .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
Click to expand...
 
Upvote 0
DanteAmor said:
Youre welcome, thanks for the feedback.
Click to expand...

Hi, I think of extent the body into 3 part. How will it be done :D


[TABLE="class: cms_table_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]
[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"]Greeting[/TD]
[TD="align: center"]Body Text[/TD]
[TD="align: center"]Signature[/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]Hi Tone[/TD]
[TD]For your information...[/TD]
[TD]Regards.[/TD]
[TD]C:\Users\ABC\Desktop\SavedFolder\Folder1[/TD]
[/TR]
</tbody>[/TABLE]


​
 
Upvote 0
harky said:
Hi, I think of extent the body into 3 part.
Click to expand...

Replace this lines.

Code: 
.Body = wks.Range("E" & i).Value & " " & _
wks.Range("F" & i).Value & " " & _
wks.Range("G" & i).Value
            wPath = wks.Range("H" & i).Value
 
Upvote 0
Thanks!

I added a break

Code: 
           .Body = wks.Range("E" & i).Value & vbNewLine & _
            wks.Range("F" & i).Value & vbNewLine & _
            wks.Range("G" & i).Value

DanteAmor said:
Replace this lines.

Code: 
.Body = wks.Range("E" & i).Value & " " & _
wks.Range("F" & i).Value & " " & _
wks.Range("G" & i).Value
            wPath = wks.Range("H" & i).Value
Click to expand...
 
Upvote 0
Hi Dante,

Regarding on the Path of Attachment folder.

Can help me?
I was thinking if possible attach email by

wherever all files* found in folder or by direct file path (if only 1 file)

e.g
C:\Users\ABC\Desktop\SavedFolder\Folder1\ (more than 1)
C:\Users\ABC\Desktop\SavedFolder\Folder1\abc.jpg (can be jpg, pdf, zip etc) (if only 1 file)

Code: 
Sub SendEmail2()
    Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
    Dim wks As Worksheet, wPath As String, wFile As Variant


    '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'
    
    lr = Cells(Rows.Count, "B").End(xlUp).Row
    Set Mail_Object = CreateObject("Outlook.Application")
    Set wks = Worksheets("SendEmail_MOD2")  'worksheet name
    For i = 2 To lr
        With Mail_Object.CreateItem(o)
            .To = wks.Range("B" & i).Value
            .CC = wks.Range("C" & i).Value
            '.BCC = wks.Range("G" & I).Value    'G is refer to column G in excel
            .Subject = wks.Range("D" & i).Value
            
            .Body = wks.Range("E" & i).Value & vbNewLine & _
            wks.Range("F" & i).Value & vbNewLine & _
            wks.Range("G" & i).Value
            
            wPath = wks.Range("H" & i).Value
            If Right(wPath, 1) <> "" Then wPath = wPath & ""
            If Dir(wPath, vbDirectory) <> "" Then
                wFile = Dir(wPath & "*.*")
                Do While wFile <> ""
                    .Attachments.Add wPath & wFile
                    wFile = Dir()
                Loop
            End If
            
            '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



DanteAmor said:
Replace this lines.

Code: 
.Body = wks.Range("E" & i).Value & " " & _
wks.Range("F" & i).Value & " " & _
wks.Range("G" & i).Value
            wPath = wks.Range("H" & i).Value
Click to expand...
 
Last edited:
Upvote 0


[TABLE="class: cms_table_cms_table_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]
[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"]Greeting[/TD]
[TD="align: center"]Body Text[/TD]
[TD="align: center"]Signature[/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]Hi Tone[/TD]
[TD]For your information...[/TD]
[TD]Regards.[/TD]
[TD]C:\Users\ABC\Desktop\SavedFolder\Folder1\
*all attach all files found in folder[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]abc@email2.com[/TD]
[TD]abc@email2.com[/TD]
[TD]test email 2[/TD]
[TD]hi tester2[/TD]
[TD]For your information..[/TD]
[TD]Regards.[/TD]
[TD]C:\Users\ABC\Desktop\SavedFolder\Folder2\abc.pdf * or direct path - can be jpg, pdf, zip, doc*[/TD]
[/TR]
</tbody>[/TABLE]


 
Last edited:
Upvote 0
Try this.


In column H the folder. In column I the pattern. It can be:
*.pdf
*.xlsx
or directly the file
dat.jpeg

Code: 
Sub SendEmail()
    Dim i As Integer, Mail_Object, Email_Subject, o As Variant, lr As Long
    Dim wks As Worksheet, wPath As String, wFile As Variant, wPattern As String


    '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("send_email")
    lr = wks.Cells(Rows.Count, "B").End(xlUp).Row
    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 & vbNewLine & _
                wks.Range("F" & i).Value & vbNewLine & _
                wks.Range("G" & i).Value
                
            wPath = wks.Range("H" & i).Value
[COLOR=#0000ff]            wPattern = wks.Range("I" & i).Value[/COLOR]
            If wPattern = "" Then wPattern = "*.*"
            If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
            If Dir(wPath, vbDirectory) <> "" Then
                wFile = Dir(wPath & wPattern)
                Do While wFile <> ""
                    .Attachments.Add wPath & wFile
                    wFile = Dir()
                Loop
            End If
            .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

I have an app with something similar your need, you can download the file and maybe it will help you.

https://www.dropbox.com/s/kb6xci9y4r9wigh/mail5d with sing html.xlsm?dl=0
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Send bulk email attachment error
Replies
3
Views
115
JOHATUP
J
N
  • Question Question
VBA: Automatically send emails in a loop with different attachments
Replies
3
Views
335
cwstudio2020
C
J
  • Question Question
VBA to send multiple emails with multiple attachments
Replies
5
Views
756
6StringJazzer
6StringJazzer
S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
292
mumps
mumps
B
  • Solved
VBA to email recipient if column cells contain value
Replies
6
Views
582
bh24524
B

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

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