excel电子邮件VBA适用于一个收件人而不是全部

时间:2015-10-21 21:31:38

标签: excel-vba vba excel

以下VBA会向多个用户发送电子邮件,但只有第一个收件人才能收到正确的电子邮件。因此,如果A列中有10个地址,那么地址1将获得正确的电子邮件,其他所有人都会获得单词For而没有其他内容。我不确定如何解决它,但认为它是偏移?谢谢你:)。

括号中的

更正电子邮件是从

中提取数据的地方
**For 10/21/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 14
            If LCase(WS.Cells(c.Row, i)) = "x" Then
                Msg = Msg & "   -" & WS.Cells(1, i) & Chr(14)
            End If
        Next)

VB

Private Sub CommandButton1_Click()

Dim WS As Worksheet, Rng As Range, c As Range
Dim OutApp As Object, OutMail As Object
Dim Msg As String, Addr As String, FName As String, i As Long
Dim obj As Object
Dim MyFile As String, MyFileCopy As String

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

'create a separate sheet2 to mail out
Sheets(2).Copy
Set wkb = ActiveWorkbook
With wkb
    .SaveAs MyFileCopy
    .Close True
End With

' 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 " & c.Offset(, 1) & Chr(14) & Chr(14)
        For i = 3 To 14
            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.Offset(, 0)
            .CC = ""
            .BCC = ""
            .Subject = "Daily Operational Safety Briefing"
            .Body = Msg
            If LCase(c.Offset(, 3)) = "x" Then .Attachments.Add MyFileCopy, 1
            .Send
        End With

Next c

'confirm message sent and delete copy
MsgBox "The data has been emailed sucessfully.", vbInformation
Kill MyFileCopy

Set OutMail = Nothing
Set OutApp = Nothing

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

End Sub

2 个答案:

答案 0 :(得分:1)

根据您的评论:So even if there are 10 email addresses B2 and either C2 or D2 will be used您需要稍微更改一下代码。

目前,您正在抓取与电子邮件地址位于同一行的单元格。因此,如果电子邮件地址为A4,则您尝试使用B4,C1,D1 ....

将该部分代码更改为:

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

答案 1 :(得分:0)

.Range("A2", .Range("A" & .Rows.Count).End(xlUp)

不应该是

 .Range("A2", .Range("A2").End(xlDown).Address)

然后

For Each c In Rng

这不应该是Rng.Cells吗?