VBA从Excel发送电子邮件(取决于条件)

Question

我是绝对的初学者，并尝试促进同事日常工作中的一些任务。我想创建一个代码，以发送提醒邮件，其中包含来自Excel文件的信息。想法是，Excel应该检查第12行中的每一行，并检查是否在列中写入" X"，标记我想发送提醒的行。使用下面的代码，我可以生成所有电子邮件，但是我很难在哪里以及如何包含检查（'if cell（s，6）。value =" 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) = ""
    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
 

Answer 1

由于您正在使用Do...Loop检查每一行，因此您需要在该循环中检查if。我已经将增量移至If之外的s，因此无论您是否创建邮件项目，都会发生这种增量。否则，您只会在有邮件项目时更改行，这意味着您将卡在没有" 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