Sending multiple emails based on Store number

[Damian37]

I'm attempting to modify some previous code I wrote which would send out an email to the email address listed in the column next to the specified value. The value was "EXPIRED", however, what I'm trying to do now is basically send out one email within the active report without sending multiple emails based on number of records, and not unique store number. Store number may be duplicated based on how much inventory is in a negative status. Store number is located in Column A and email address is located in Column 31. As I stated before I would like to attach a copy of the report so all Managers can see how much inventory is in negative status, but only send one email regardless of how many records they have. Here's the code I've modified, but the line of code that I'm unsure as to how to modify is:

Line of code:

If MailDest = "" And Cells(iCounter, 1).Offset(0, -30) = "EXPIRED" Then

Here's the full code:

Sub OutlookEmail()
Dim OutLookApp As Object
  Dim OutLookMailItem As Object
  Dim iCounter As Integer
  Dim MailDest As String
  Dim MailDest2 As String
  Set OutLookApp = CreateObject("Outlook.application")
  Set OutLookMailItem = OutLookApp.CreateItem(0)

  Worksheets("Sheet1").Activate

  For iCounter = 2 To WorksheetFunction.CountA(Columns(31))
     MailDest = ""
     If Len(Cells(iCounter, 1).Offset(0, -0)) > 0 Then
     If MailDest = "" And Cells(iCounter, 1).Offset(0, -30) = "EXPIRED" Then
     Set OutLookMailItem = OutLookApp.CreateItem(0)
     With OutLookMailItem
     MailDest = Cells(iCounter, 31).Value
     'MailDest2 = Cells(iCounter, 31).Value
        .To = MailDest
        .CC = "email1@somedomain.com"; "email2@somedomain.com"; "email2@somedomain.com"
        '.BCC = "email4@somedomain.com"
        .Subject = "Subject"
        .HTMLBody = "Hello" & MailDest & "," _
            & "Email body here..."
    '.Display
    .Send
    End With
        End If
   End If
    Next iCounter
  Set OutLookMailItem = Nothing
  Set OutLookApp = Nothing
End Sub
End Sub

Any and all help is greatly appreciated.
D.

 

[Damian37]

Just an update, when I attempt to run the code, I am now receiving a Run-Time error '1004': Application-Defined or Object-Defined error. When I click on debug. The below line of code is highlighted:

If MailDest = "" And Cells(iCounter, 1).Offset(0, -20) < 0 Then

I'm trying to get my code to verify the value within column 20 is negative, and then have an email created based on the value within column 31. Thank you for any help.
D.

 

[Damian37]

Just an update, when I attempt to run the code, I am now receiving a Run-Time error '1004': Application-Defined or Object-Defined error. When I click on debug. The below line of code is highlighted:

If MailDest = "" And Cells(iCounter, 1).Offset(0, -20) < 0 Then

I'm trying to get my code to verify the value within column 20 is negative, and then have an email created based on the value within column 31. Thank you for any help.
D.

Hello to anyone. I have been able to resolve all error issues with my code. I do have an issue with my final sub statement. I run the outlook portion in order for it to open up one email based on store number. There can be multiple records for the same email address, because the person with the email address could have more than one piece of inventory that needs to be addressed. Rather than send an individual email for each inventory item, I just need 1 email sent out to the recipient with the new created file attached to the email. Here's the code I'm currently using to try and get the generic emails to be created:

Sub OutlookEmail()
 
  Dim OutLookApp As Object
  Dim OutLookMailItem As Object
  Dim iCounter As Integer
  Dim MailDest As String
  'Dim MailDest2 As String
  Set OutLookApp = CreateObject("Outlook.application")
  Set OutLookMailItem = OutLookApp.CreateItem(0)

  ThisWorkbook.Sheets("Sheet1").Activate

  For iCounter = 2 To WorksheetFunction.CountA(Columns(32))
     MailDest = ""
     If Len(Cells(iCounter, 1).Offset(0, -0)) > 0 Then
     If MailDest = "" And Cells(iCounter, 1).Offset(0, -20) < 0 Then
     Set OutLookMailItem = OutLookApp.CreateItem(0)
     With OutLookMailItem
     MailDest = ThisWorkbook.Sheets("Sheet1").Cells(iCounter, 32).Value
     'MailDest2 = Cells(iCounter, 31).Value
        .To = MailDest
        .CC = "email1@somedomain.com"
        .CC = "email2@somedomain.com"
        .CC = "email3@somedomain.com"
        .Subject = "Subject"
        .HTMLBody = "Hello" & MailDest & "," _
            & "Email body here..."
        .Attachments.Add ActiveWorkbook.wkb2
    .Display
    '.Send
    End With
        End If
   End If
    Next iCounter
  Set OutLookMailItem = Nothing
  Set OutLookApp = Nothing
End Sub

All help is welcome. Thank you.
D.

 

[Damian37]

I've tried the following modifications, and now I am no longer receiving an error, however, there are no longer any generic emails when I attempted to modify the code to only select one unique email address from a list where duplicate emails exist. Now I'm not getting any error messages or generic emails. I get nothing. Here's the code I'm using now:

Sub OutlookEmail()
  
  Dim OutLookApp As Object
  Dim OutLookMailItem As Object
  Dim cell As Object
  Dim MailDest As String
  'Dim MailDest2 As String
  Set OutLookApp = CreateObject("Outlook.application")
  Set OutLookMailItem = OutLookApp.CreateItem(0)
  
'  Worksheets("Data").Activate
    'Set Rng = ActiveWorkbook.Worksheets("Data").Range("AF2:AF" & lrow)
'  For iCounter = 2 To WorksheetFunction.CountA(Columns(32))
  For Each cell In Worksheets("Data").Columns(32).Cells.SpecialCells(xlCellTypeConstants)
     MailDest = ""
     If Len(Cells(32).Offset(0, -31)) > 0 Then
     If MailDest = "" And Cells(32).Offset(0, -12) < 0 Then
     If cell.Value Like "*@*.*" And _
        Application.WorksheetFunction.CountA(Columns(32)) > 0 Then
'        If Not Contains(myColl, CStr(cell.Value)) Then
'                 myColl.Add CStr(cell.Value), CStr(cell.Value)
                 'Set OutLookMailItem = OutLookApp.CreateItem(0)
     With OutLookMailItem
     'MailDest = Cells(iCounter, 32).Value
     'MailDest2 = Cells(iCounter, 31).Value
        .To = "Damian_Velez@cable.comcast.com"
        .CC = "Davon_Johnston@cable.comcast.com; Casey_Montgomery@cable.comcast; Damian_Velez@cable.comcast.com"
        .Subject = "Negative Replenishment"
        .HTMLBody = "Hello, " & "MailDest<p>" _
            & "Your store(s) is/are reporting negative inventory on one or more SKUs. " _
            & "The SKUs that have negative counts will impact replenishment of that particular SKU(s). " _
            & "Please cycle count the below SKU(s) and enter the corrected on hand quantity into the system to prevent further impact to replenishment. " _
            & "Please remember a negative inventory count on 1 SKU will stop replenishment on that 1 SKU, " _
            & "more than 5 negative inventory counts on devices will impact all device replenishment, " _
            & "and more than 20 negatives on accessories will impact replenishment on all accessories until counts are corrected. " _
            & "If you are having an issue correcting your negative inventory please open a Service Now ticket for xStore issues." _
            & "For inventory related issues, please open a ticket in Spice Works for the Supply Chain Support Desk (SCSD).<p>" _
            & "Thank You,<p>" & "Davon Johnston<br>" _
            & "<font color=""red"">Manager, Supply Chain Support, Strategic Development</font><br>" _
            & "Cell #: 720-357-0303<br>" _
            & "Desk #: 303-658-7803"
            .Attachments.Add ActiveWorkbook.FullName
            
    .Display
    '.Send
    End With
            End If
        End If
    End If
'   End If
    Next cell
  Set OutLookMailItem = Nothing
  Set OutLookApp = Nothing
End Sub

I appreciate any ideas anyone might have. Thank you.
D.

 

[Damian37]

Hello Everyone,
I've gotten my email code to work in order to only create one email even though the email address appears more than once.
However, it is attaching the file I wish to attach to equal the same amount of records within the file. For example, if
the recipient has 3 records in the file. 1 email is created, but 3 attachments are placed within the email. I would like
1 email be sent to the recipient even though they may have more than 1 record in the file, and I would like only 1 attachment
be placed within the email.

Sub OutlookEmail()
 
  Dim OutLookApp As Object
  Dim OutLookMailItem As Object
  Dim iCounter As Integer
  Dim MailDest As String


  Set OutLookApp = CreateObject("Outlook.application")
  Set OutLookMailItem = OutLookApp.CreateItem(0)
 
  Worksheets("Data").Activate
  

  For iCounter = 2 To WorksheetFunction.CountA(Columns(32))


     MailDest = ""

     If Len(Cells(iCounter, 32).Offset(0, -31)) > 0 Then
     If MailDest = "" And Cells(iCounter, 32).Offset(0, -12) < 0 Then
     If Cells(iCounter, 32).Value Like "*@*.*" And _
        Application.WorksheetFunction.CountA(Columns(32)) > 0 Then



     With OutLookMailItem

     MailDest = Cells(iCounter, 32).Value


        .To = "email1@somedomain.com"
        .CC = "email2@somedomain.com; email3@somedomain.com; email4@somedomain.com"
        .Subject = "Subject"
        .HTMLBody = "Hello, " & Cells(iCounter, 31).Value & "<p>" _
                          & "Email body here..."
            .Attachments.Add ActiveWorkbook.FullName
           
    .Display

    End With
            End If
        End If
    End If


    Next iCounter

  Set OutLookMailItem = Nothing
  Set OutLookApp = Nothing

End Sub

As I said the code is working to only create 1 email no matter how many records the person has, but there are too many attachments
currently being added to the email. All help is greatly appreciated!
D.