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
I tested the code.
I got an error.

The pop-up say
Run-time error '52'
Bad File name or number

-> Debug

wFile = Dir(wPath & wPattern)

DanteAmor said:
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
Click to expand...
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
harky said:
I tested the code.
I got an error.

The pop-up say
Run-time error '52'
Bad File name or number

-> Debug

wFile = Dir(wPath & wPattern)
Click to expand...

But what did you put in the cell in column I. You can show me.


Obviously the file that you put in column I must exist in the folder.
 
Upvote 0
C:\Users\ABC\Desktop\SavedFolder\Email1\test.JPG

The file it already saved @ folder
I also used the one file which u shared from dropbox to cfm the path is correct

KpeiPti.jpg


DanteAmor said:
But what did you put in the cell in column I. You can show me.


Obviously the file that you put in column I must exist in the folder.
Click to expand...
 
Last edited:
Upvote 0
oh........ i tot is direct link.
There no way to use direct link?

Dont like the idea of spilting folder path than filename.*

DanteAmor said:
In column H you should put:


In column I you should put:
Click to expand...
 
Last edited:
Upvote 0
harky said:
I tested the code.
I got an error.

The pop-up say
Run-time error '52'
Bad File name or number

-> Debug

wFile = Dir(wPath & wPattern)
Click to expand...

They are different macros. Which of them are you testing?
 
Upvote 0
I using this one which given by you. Not the dropbox one.

My idea was
Use either Folder or Direct Full link under Col H.


But tht code given by ur is

H = Folder Path
I = Filename.**

But since is SINGLE Direct Full link, i tot is better to use Col H rather than add more 1 col just for a filename

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





DanteAmor said:
They are different macros. Which of them are you testing?
Click to expand...
 
Last edited:
Upvote 0
please, make a test. put the folder in H and in I the pattern or the file but in H only the folder.
 
Upvote 0
harky said:
Dont like the idea of spilting folder path than filename.*
Click to expand...


Try this

In H put the folder and the pattern
Examples:

C:\Users\ABC\Desktop\SavedFolder\Email1\test.JPG
C:\Users\ABC\Desktop\SavedFolder\Email1\*.pdf
C:\Users\ABC\Desktop\SavedFolder\Email1\*



Code: 
Sub SendEmail()
    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


    '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
             
            pf = wks.Range("H" & i).Value
            d = InStrRev(pf, "\")
            wPath = Left(pf, d)
            wPattern = Mid(pf, d + 1)
            If wPattern = "" Then wPattern = "*.*"
            'If Right(wPath, 1) <> "\" Then wPath = wPath & "\"
            If Dir(wPath, vbDirectory) <> "" Then
                wFile = Dir(wPath & wPattern)
                On Error Resume Next
                Do While wFile <> ""
                    'If Dir(wPath & wFile) <> "" Then
                        .Attachments.Add wPath & wFile
                    'End If
                    wFile = Dir()
                Loop
                On Error GoTo 0
            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

Now, you already have 2 versions, in a column and in 2 columns.
 
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
294
cwstudio2020
C
J
  • Question Question
VBA to send multiple emails with multiple attachments
Replies
5
Views
676
6StringJazzer
6StringJazzer
S
  • Question Question
VBA sending an email of two conditions are met
Replies
5
Views
138
mumps
mumps
B
  • Solved
VBA to email recipient if column cells contain value
Replies
6
Views
541
bh24524
B
L
  • Question Question
Sending Email with Table in Body
Replies
3
Views
619
Domenic
D

Forum statistics

Threads
1,223,903
Messages
6,175,289
Members
452,631
Latest member
a_potato

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