VBA to send emails attachment base on path (folder)

harky

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

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

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

DanteAmor

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

harky

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



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

harky

Active Member
Joined
Apr 8, 2010
Messages
313
oh........ i tot is direct link.
There no way to use direct link?

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

In column H you should put:


In column I you should put:
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,208
Office Version
2007
Platform
Windows
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)
They are different macros. Which of them are you testing?
 

harky

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




They are different macros. Which of them are you testing?
 
Last edited:

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,208
Office Version
2007
Platform
Windows
please, make a test. put the folder in H and in I the pattern or the file but in H only the folder.
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,208
Office Version
2007
Platform
Windows
Dont like the idea of spilting folder path than filename.*

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.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,662
Messages
5,488,166
Members
407,628
Latest member
Faceless Judge

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top