时间戳

首页 > 解决方案 > 从单元格向不同地址发送电子邮件

excel - 从单元格向不同地址发送电子邮件

问题描述

我在“Sheet1”中有许多电子邮件地址，在 K、M、O、Q、S、U、W、Y、AA 列中。
我想创建一封电子邮件，该电子邮件将发送到 Sheet1 最后一行中的所有地址。从最后一行获取的电子邮件正文中的数据也是如此。

Dim MonOutlook As Object
Dim MonMessage As Object
Dim EmailTo As String

With Worksheets("Sheet1")
    EmailTo = .Range("K" & ligne) & ";" & .Range("M" & ligne) & ";" & .Range("O" & ligne) & ";" & .Range("Q" & ligne) & ";" & .Range("S" & ligne) & ";" & .Range("U" & ligne) & ";" & .Range("W" & ligne) & ";" & .Range("Y" & ligne) & ";" & .Range("AA" & ligne)
End With

Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)

    MonMessage.To = ""
    MonMessage.Cc = ""
    MonMessage.Bcc = EmailTo
    MonMessage.Subject = "Rate request" & " " & "for" & " " & ThisWorkbook.Sheets("Sheet1").Range("B" & ligne)
    MonMessage.body = "Hello,"
                Chr (13) & Chr(13) & "Please send me rate for" & " " & ThisWorkbook.Sheets("Sheet1").Range("G" & ligne) & " " & "rooms on basis" & " " & ThisWorkbook.Sheets("Sheet1").Range("H" & ligne) & _
                Chr(13) & Chr(13) & "in hotel:" & " " & ThisWorkbook.Sheets("Sheet1").Range("J" & ligne) & _
                Chr(13) & Chr(13) & "for the period" & " " & ThisWorkbook.Sheets("suivi").Range("C" & ligne) & " " & ThisWorkbook.Sheets("Sheet1").Range("D" & ligne) & _
                Chr(13) & Chr(13) & "Thank you!" & _
                Chr(13) & Chr(13) & Application.UserName & " " & "-" & " " & "x Tours"

    MonMessage.Display

    With ThisWorkbook.Sheets("Sheet1").Range("AB" & ligne)
        .Value = Date
        .NumberFormat = "dd/mm/yyyy"
    End With

    ActiveWorkbook.Save

标签： excelvba

解决方案

试试下面的代码，代码注释中的解释。

Option Explicit

Sub EmailContactsLastRow()

Dim MonOutlook As Object
Dim MonMessage As Object
Dim EmailSht As Worksheet
Dim EmailTo As String
Dim ligne As Long

' set the worksheet object
Set EmailSht = ThisWorkbook.Sheets("Sheet1")

With EmailSht
    ligne = .Cells(.Rows.Count, "K").End(xlUp).Row ' get last row with data in column K

    EmailTo = .Range("K" & ligne) & ";" & .Range("M" & ligne) & ";" & .Range("O" & ligne) & ";" & _
            .Range("Q" & ligne) & ";" & .Range("S" & ligne) & ";" & .Range("U" & ligne) & ";" & _
            .Range("W" & ligne) & ";" & .Range("Y" & ligne) & ";" & .Range("AA" & ligne)
End With

Set MonOutlook = CreateObject("Outlook.Application")
Set MonMessage = MonOutlook.CreateItem(0)

With MonMessage
    .To = ""
    .Cc = ""
    .Bcc = EmailTo
    .Subject = "Rate request" & " " & "for" & " " & EmailSht.Range("B" & ligne)
    .body = "Hello,"
                Chr (13) & Chr(13) & "Please send me rate for" & " " & EmailSht.Range("G" & ligne) & " " & "rooms on basis" & " " & EmailSht.Range("H" & ligne) & _
                Chr(13) & Chr(13) & "in hotel:" & " " & EmailSht.Range("J" & ligne) & _
                Chr(13) & Chr(13) & "for the period" & " " & EmailSht.Range("C" & ligne) & " " & EmailSht.Range("D" & ligne) & _
                Chr(13) & Chr(13) & "Thank you!" & _
                Chr(13) & Chr(13) & Application.UserName & " " & "-" & " " & "x Tours"

    .Display ' <-- this displays the email. not sending it
    .send ' <-- this sends the email out
End With

With EmailSht.Range("AB" & ligne)
    .Value = Date
    .NumberFormat = "dd/mm/yyyy"
End With

ThisWorkbook.Save

End Sub

推荐阅读