CODEWITHSUNDEEP
vbaexcelemail
Miri
Miri

Reputation: 19

VBA send email from excel (depending on condition)

I am an absolute beginner and try to facilitate a few tasks in my colleagues daily work. I want to create a code that sends reminder mails with information from an excel file. The idea is that Excel should check every relevant row from row 12 on and check if there is an "x" written in a column that marks for which row I would like to send a reminder. With the code below I can generate all the emails, but I have difficulties where and how to include the check for if ('If Cells(s, 6).Value = "x" Then') so that that Excel continues through all the rows that are filled out.

Many thanks for your help!

 
Sub SendReminderMail() 
  Dim s As Long
  Dim OutLookApp As Object
  Dim OutLookMailItem As Object
  Dim iCounter As Integer
  Dim MailDest As String

  If MsgBox("Are you sure?", vbYesNo) = vbNo Then Exit Sub

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

  s = 12

  Do Until Trim$(Cells(s, 1).Value) = ""

    Set OutLookMailItem = OutLookApp.CreateItem(0)
    With OutLookMailItem
      .To = Cells(s, 5).Value
      .Subject = "Reminder: " & Cells(1, 7).Value
      .Body = "Text, " & vbCrLf & vbCrLf & "Text'" & Cells(s, 2).Value 
      s = s + 1
      .Display
    End With
  Loop
End Sub

Upvotes: 1

Views: 3927

Answers (1)

Dave
Dave

Reputation: 4356

Since you are checking every row with the Do...Loop then you need to check the if inside that loop. I've moved the increment to s outside the If so that it happens whether or not you create a mail item. Otherwise you'd only change rows if there was a mail item to send, and that means you'd be stuck looping on a row where there was no "x".

Sub SendReminderMail() 
    Dim s As Long
    Dim OutLookApp As Object
    Dim OutLookMailItem As Object
    Dim iCounter As Integer
    Dim MailDest As String

    If MsgBox("Are you sure?", vbYesNo) = vbNo Then Exit Sub

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

    s = 12

    Do Until Trim$(Cells(s, 1).Value) = ""
      If Cells(s,6).Value = "x" Then
          Set OutLookMailItem = OutLookApp.CreateItem(0)
          With OutLookMailItem
              .To = Cells(s, 5).Value
              .Subject = "Reminder: " & Cells(1, 7).Value
              .Body = "Text, " & vbCrLf & vbCrLf & "Text'" & Cells(s, 2).Value 
              .Display
          End With
      End If
      s = s + 1
    Loop
End Sub

Upvotes: 1

Related Questions