Question

我在“ 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

Answer 1

尝试以下代码，并在代码注释中进行解释。

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

将电子邮件发送到单元中的各种地址

1 个答案: