VBA Sending Email Based On Cell Values in Column

richardtims

New Member
Joined
Jun 25, 2018
Messages
31
Hello,

I am still somewhat new to the VBA coding, but I have learned an extreme amount in the past few months. The background of what I am needing to accomplish is to send reports based on whether I have updated the report. I have already figured out how to make the email get the subject, email address, path, and file name from the appropriate fields which has been challenging.

I am having 2 small issues however. First issue is I am trying to get my default Outlook email signature to be included in my emails that I am generating. I do need to I would prefer to use the .send over the .display if possible.

My second issue is setting up the macro to look at Column A to determine whether or not to send the email to that row of information. I want the macro to look at column A for as many lines are there (Currently 10 rows) and if the cell in column A is blank, I want it to send an email. If it has anything else like an "x", I want it to skip over that row and proceed to the next.

If this is covered in a different thread, please let me know. I have spent hours upon hours searching for a solution that I can implement without breaking what I have worked on so far.

I have pasted my code below. Please forgive me if there is unnecessary coding or missing coding. This is still somewhat new to me and any help is appreciated.

Sub MailReports()
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Set ws = Sheets("Sheet1")
With OutMail
.To = ActiveSheet.Range("D4")
.CC = ""
.BCC = ""
.subject = Range("C4").Value
.Attachments.Add Range("E4").Value & "" & Range("F4").Value & Range("G4").Value
.Body = ""
.Display 'would prefer .Send instead of .Display

End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
 
Re: VBA Need Help Sending Email Based On Cell Values in Column

Here you go. This was a near impossible task. Let me know if you see it now.

Capture.JPG
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Re: VBA Need Help Sending Email Based On Cell Values in Column

I can see it now. Bravo! Let me take a look at what you have presented here and try to test it out.
 
Upvote 0
Re: VBA Need Help Sending Email Based On Cell Values in Column

Richard - I was able to test this in part. I made a mistake in my previous code of using ActiveCell.Row instead of i. I was able to see that the values found in Columns B:D were populating in the email on the rows where there is no "x" in Column A. I am not able to test for the attachment of the file due to IT restrictions.

Let me know if this works for you.

Code:
Sub SendEmail()
Dim N As Long, i As Long
Dim OApp As Object, OMail As Object, Signature As String, rng As Range

Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)
Set ws = Sheets("Sheet1")

N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 4 To N
        If Cells(i, "A").Value = "" Then
            With OMail
                .Display
            End With
            With OMail
                .To = ActiveSheet.Range("D" & i)
                .Subject = Range("C" & i).Value
                .Attachments.Add Range("E" & i).Value
                .Display 'Can substitute .Send to send instead of .Display which will allow edit before sending
            End With

            Set OMail = Nothing
            Set OApp = Nothing

        End If
    Next i
End Sub
 
Upvote 0
Re: VBA Need Help Sending Email Based On Cell Values in Column

I should also point out that in the screenshot you shared, you begin your data entry on row 4. On this line of code, if you ever adjust where the data entry starts, it'll need to be adjusted as well.

Code:
For i = 4 To N
 
Upvote 0
Re: VBA Need Help Sending Email Based On Cell Values in Column

First, I want to thank you again for all your time you have put into this. I think we are very close. Here is what is happening. The script is only sending one email even if I have the "x" removed from all 3. Secondly, it is giving me the following errors that I have included images. I have also included an image of where in the code it is asking me to debug. Also, if I am looking at the code correctly, is it doing a count of column A to determine how many time to repeat? If so, should we not use a different column that would always have data in it? Just wanted to see if that was the case. Thanks in advance for your help.

Capture1.JPG


Capture2.JPG
 
Upvote 0
Re: VBA Need Help Sending Email Based On Cell Values in Column

Hopefully we'll get you there. I took something that Ron DeBruin built and modified it to fit your purposes. I did get multiple emails to populate but I cannot test the attached file portion. Fingers crossed.

Code:
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, FileCell, rng As Range
    Dim N As Long

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

    Set sh = Sheets("Sheet1")
    N = Cells(Rows.Count, "B").End(xlUp).Row
    
    Set rng = Range("A4:A" & N)

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In rng

        If cell.Value = "" Then
            Set OutMail = OutApp.CreateItem(0)
            
            ToLine = Range("D" & cell.Row).Value
            SubjectLine = Range("C" & cell.Row).Value

            With OutMail
                .To = ToLine
                .Subject = SubjectLine
                '.Attachments.Add Range("E" & i).Value
                .Display  '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
 
Upvote 0
Re: VBA Need Help Sending Email Based On Cell Values in Column

PROBLEM SOLVED!!!!!

I did have to make one small correction to the attachment line of the code. It successfully attached the files to the emails. I have included the final code below. Thanks for all the time you spent on this. It is going to save me a lot of time.

Code:
Public Sub Send_Email()
'Working in Excel 2000-2016
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sh As Worksheet
    Dim cell, FileCell, rng As Range
    Dim N As Long
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set sh = Sheets("Sheet1")
    N = Cells(Rows.Count, "B").End(xlUp).Row
    
    Set rng = Range("A4:A" & N)
    Set OutApp = CreateObject("Outlook.Application")
    For Each cell In rng
        If cell.Value = "" Then
            Set OutMail = OutApp.CreateItem(0)
            
            ToLine = Range("D" & cell.Row).Value
            SubjectLine = Range("C" & cell.Row).Value
            With OutMail
                .To = ToLine
                .subject = SubjectLine
                .Attachments.Add Range("E" & cell.Row).Value
                .Display  '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
 
Upvote 0
Re: VBA Need Help Sending Email Based On Cell Values in Column

You're welcome, man. I'm glad it helped and I'm grateful for the feedback.
 
Upvote 0

Forum statistics

Threads
1,216,126
Messages
6,129,021
Members
449,480
Latest member
yesitisasport

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