VBA to send emails attachment base on path (folder)

harky

Active Member
Joined
Apr 8, 2010
Messages
313
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:

Some videos you may like

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,152
Office Version
2007
Platform
Windows
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.
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
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
Thanks! this works great.. thanks pal!

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
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
Youre welcome, thanks for the feedback.
Hi, I think of extent the body into 3 part. How will it be done :D


ABCDEFEF
S/NTo:ccSubjectGreetingBody TextSignaturePath of Attachment folder
1abc@email1.comabc@email1.comtest email 1Hi ToneFor your information...Regards.C:\Users\ABC\Desktop\SavedFolder\Folder1

<tbody>
</tbody>


 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,152
Office Version
2007
Platform
Windows
Hi, I think of extent the body into 3 part.
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
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
Thanks!

I added a break

Code:
           .Body = wks.Range("E" & i).Value & vbNewLine & _
            wks.Range("F" & i).Value & vbNewLine & _
            wks.Range("G" & i).Value
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
 

harky

Active Member
Joined
Apr 8, 2010
Messages
313
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


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
 
Last edited:

harky

Active Member
Joined
Apr 8, 2010
Messages
313


ABCDEFEF
S/NTo:ccSubjectGreetingBody TextSignaturePath of Attachment folder
1abc@email1.comabc@email1.comtest email 1Hi ToneFor your information...Regards.C:\Users\ABC\Desktop\SavedFolder\Folder1\
*all attach all files found in folder
2abc@email2.comabc@email2.comtest email 2hi tester2For your information..Regards.C:\Users\ABC\Desktop\SavedFolder\Folder2\abc.pdf * or direct path - can be jpg, pdf, zip, doc*

<tbody>
</tbody>


 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,152
Office Version
2007
Platform
Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,260
Messages
5,485,728
Members
407,510
Latest member
Tryintouseexcel

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top