电子邮件不适用于所有收件人

时间:2015-10-23 16:51:08

标签: excel excel-vba vba

当有多个用户时,发送的第一封电子邮件是正确的,但在第二封电子邮件中只显示For 10/23/2015。以下是正确电子邮件的副本以及数据来源和代码。

更正电子邮件

**For 10/2/2015** ( Msg = "For " & c.Offset(, 1) & Chr(14) & Chr(14)

**-There are no issues to report in the HLA & Molecular Diagnostics Laboratory.** (   For i = 3 To 4
        If LCase(WS.Cells(c.Row, i)) = "x" Then
            Msg = Msg & "   -" & WS.Cells(1, i) & Chr(14)
        End If
    Next)

VBA

Private Sub Workbook_Open()
Dim sR As String
Dim intAnswer As Integer


'open sheet
 Sheets("Email").Activate
 intAnswer = MsgBox("Are there any issues to report", vbYesNoCancel)
  Select Case intAnswer
  Case vbYes
  Range("D2").Value = "x"
  MsgBox ("Please select an issue and save"), vbExclamation
  Case vbCancel
  Application.SendKeys "%{F11}", True
  Case Else
  Range("C2").Value = "x"
  End Select

'define path
 MyFileCopy = "L:\NGS\HLA LAB\total quality management\QC & QA\DOSE reports\DOSE reporting form Attachment.xlsx"

'create connection, check condition, send email
Set OutApp = CreateObject("Outlook.Application")
Set WS = ThisWorkbook.Sheets("Email")
With WS
Set Rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
 End With

 For Each c In Rng

 Msg = "For " & WS.Cells(2, 2) & Chr(14) & Chr(14)
 For i = 3 To 4
 If LCase(WS.Cells(c.Row, i)) = "x" Then
    Msg = Msg & "   -" & WS.Cells(1, i) & Chr(14)
 End If
 Next

    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = c
        .CC = ""
        .BCC = ""
        .Subject = "Daily Operational Safety Briefing"
        .Body = Msg
        If Range("D2").Value & Chr(14) = "x" Then .Attachments.Add MyFileCopy, 1
        .Send
    End With
Next c

'confirm message sent, clear sheet, and delete copy
 MsgBox "The data has been emailed sucessfully.", vbInformation
 Range("C2:D2").ClearContents
 Kill MyFileCopy

 Set OutMail = Nothing
 Set OutApp = Nothing

'Exit and do not save
 Application.Quit
 ThisWorkbook.Close SaveChanges:=False
 End Sub

1 个答案:

答案 0 :(得分:1)

根据您共享数据结构的previous question,我知道答案。 (否则,你的帖子没有提供足够的细节来明确你的要求。)

您遇到的问题是,当您通过For each c in rng遍历A列中的每个单元格(所有电子邮件)时,您还会测试C列或D列是否包含x的条件。 If LCase(WS.Cells(c.Row, i)) = "x" Then中的一行。由于您的数据集仅在第2行中包含消息信息(如上一个问题所示),因此每次循环时都需要始终检查第2行。

所有这一切,改变

If LCase(WS.Cells(c.Row, i)) = "x" Then

If LCase(WS.Cells(2, i)) = "x" Then

你会得到你想要的结果。