VBA to send emails attachment base on path (folder)

harky

Active Member
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:

DanteAmor

Well-known Member
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
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
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>


 

harky

Active Member
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
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


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

Some videos you may like

This Week's Hot Topics

Top