如何将发件人添加到在VBA excel中发送电子邮件的宏

时间:2017-03-09 14:40:20

标签: excel vba excel-vba email

我在互联网上发现了一段代码,根据excel电子表格的数据发送带附件的电子邮件。代码完美无缺,但我想知道的是如何更改电子邮件来自的邮箱?目前,他们来自按下发送邮箱的用户。但我想要的是他们来自用户有权访问的特定邮箱,请参阅下面的代码:

Sub Send_Files()
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set sh = Sheets("Sending Tool")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("D").Cells.SpecialCells(xlCellTypeConstants)

    'Enter the File Path in E1, you can add more files and extend the range if needed
    Set rng = sh.Cells(cell.Row, 1).Range("E1:K1")

    If cell.Value Like "?*@?*.?*" And _
       Application.WorksheetFunction.CountA(rng) > 0 Then
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .to = cell.Value
            .Subject = "Email Header"
            ' This is the body of the email, change the next line to change the email's contents. use "<br>" to create a line break in the email
            .HTMLBody = "Good Morning " & cell.Offset(0, -3).Value & "," & "<br>" & "<br>" & "Body" 
            For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                If Trim(FileCell) <> "" Then
                    If Dir(FileCell.Value) <> "" Then
                        .Attachments.Add FileCell.Value
                    End If
                End If
            Next FileCell

            .Send  'Or use .Display
        End With

        Set OutMail = Nothing
    End If
Next cell

Set OutApp = Nothing
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

MsgBox ("Emails Sent Successfully")

End Sub

为了我的例子,我们打电话给邮箱userhelp@example.co.uk,我希望这是一个外发邮箱,这样如果收件人希望回复它,那么它会回到那里而不是用户的个人电子邮件。

1 个答案:

答案 0 :(得分:0)

尝试

.ReplyRecipientNames = "userhelp@example.co.uk"