简体   繁体   中英

excel email VBA works for one recipient not all

The VBA below will send an email to multiple users, however only the first recipient gets a correct email. So, if there are 10 address's in column A, then address 1 will get the correct email, all others get the word For and nothing else. I'm not sure how to fix it, but think it is the offset? Thank you :).

Correct Email in parenthesis is where the data is pulled from

**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

As per your comment: So even if there are 10 email addresses B2 and either C2 or D2 will be used you need to change the code slightly.

Currently you are grabbing the cell on the same row as the email address. So if the email address is A4, you are trying to use B4,C1,D1....

Change that part of the code to this:

    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
.Range("A2", .Range("A" & .Rows.Count).End(xlUp)

Shouldn't this be

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

And then

For Each c In Rng

Shouldn't this be Rng.Cells?

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM