cancel
Turn on suggestions
Auto-suggest helps you quickly narrow down your search results by suggesting possible matches as you type.
Showing results for 
Show  only  | Search instead for 
Did you mean: 
SOLVED

Macro used to send automatic emails

DrishM
Copper Contributor

‎Dec 20 2020 10:15 PM

‎Dec 20 2020 10:15 PM

Macro used to send automatic emails

I am using the Ron de Bruin macro to send automatic emails to various users and that is working perfectly.

As below:

Sub Send_Files()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set sh = Sheets("book1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

'Enter the path/file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)

With OutMail
.to = cell.Value
.Subject = "Attachments for Account - " & cell.Offset(0, -1).Value
.BodyFormat = 1
.HTMLBody = "<HTML><body> Good day, <p> Please find attached document for your attention. </p> <p> Thank you. </p> <p> Regards. </p> </body></HTML>"

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send 'Or use .Display
End With

Set OutMail = Nothing
End If
Next cell

Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

My columns in Excel are as follows:

  • Account Name
  • Email
  • File name

The "account name" and the "file name" (file I am linking to) is exactly the same.

Is it possible to add onto the existing macro a way in which that account name will automatically filter against a specified folder on Windows and add the links to the on the "file names" column automatically on the Excel sheet instead of manually going to change it? This will be changed every month.

2,231 Views
0 Likes
1 Reply
Reply
1 Reply
best response confirmed by DrishM (Copper Contributor)
Hans Vogelaar

‎Dec 21 2020 03:12 AM

‎Dec 21 2020 03:12 AM

Solution

Re: Macro used to send automatic emails

@DrishM 

Make sure that the file names in column C include the extension (e.g. Report.pdf, not Report).

See if this does what you want:

 

Sub Send_Files()
    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    ' *** Change as needed, keep trailing backslash ***
    Const Folder = "C:\Attachments\"

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")

    Set sh = Sheets("book1")
    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = cell.Value
                .Subject = "Attachments for Account - " & cell.Offset(0, -1).Value
                .BodyFormat = 1
                .HTMLBody = "<HTML><body> Good day, <p> Please find attached document for your attention. </p> " & _
                    "<p> Thank you. </p> <p> Regards. </p> </body></HTML>"

                Set FileCell = cell.Offset(0, 1)
                If Trim(FileCell.Value) <> "" Then
                    If Dir(Folder & FileCell.Value) <> "" Then
                        .Attachments.Add Folder & FileCell.Value
                    End If
                End If

                .Send 'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
0 Likes
Reply
1 best response

Accepted Solutions
best response confirmed by DrishM (Copper Contributor)
Hans Vogelaar

‎Dec 21 2020 03:12 AM

‎Dec 21 2020 03:12 AM

Solution

Re: Macro used to send automatic emails

@DrishM 

Make sure that the file names in column C include the extension (e.g. Report.pdf, not Report).

See if this does what you want:

 

Sub Send_Files()
    'Working in Excel 2000-2016
    'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm

    ' *** Change as needed, keep trailing backslash ***
    Const Folder = "C:\Attachments\"

    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell As Range
    Dim FileCell As Range

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set OutApp = CreateObject("Outlook.Application")

    Set sh = Sheets("book1")
    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
            Set OutMail = OutApp.CreateItem(0)

            With OutMail
                .To = cell.Value
                .Subject = "Attachments for Account - " & cell.Offset(0, -1).Value
                .BodyFormat = 1
                .HTMLBody = "<HTML><body> Good day, <p> Please find attached document for your attention. </p> " & _
                    "<p> Thank you. </p> <p> Regards. </p> </body></HTML>"

                Set FileCell = cell.Offset(0, 1)
                If Trim(FileCell.Value) <> "" Then
                    If Dir(Folder & FileCell.Value) <> "" Then
                        .Attachments.Add Folder & FileCell.Value
                    End If
                End If

                .Send 'Or use .Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

View solution in original post

0 Likes
Reply