VBA Mass电子邮件问题

时间:2018-10-04 15:07:54

标签: excel vba excel-vba

我是VBA新手。我正在尝试向个人发送量身定制的电子邮件。

这是我所拥有的,但是我不断出现“ mail_body_message = Sheet1.Range(“ U3”)]高亮显示的“需要对象”错误。然后有时会出现“未定义”错误[Sub SendMassEmail()]高亮显示。我需要帮助。我知道我已经接近了,但令人沮丧。

    Sub SendEmail(what_address As String, carbon_copy As String, subject_line As String, mail_body As String)

Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")

    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)

    olMail.To = what_address
    olMail.CC = carbon_copy
    olMail.Subject = subject_line
    olMail.Body = mail_body
    olMail.Send


End Sub
Sub SendMassEmail()

row_number = 1

Do
DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    Dim email_address As String
    Dim supervisor_email As String
    Dim date_time As String
    Dim computer_used As String
    Dim device_description As String

    mail_body_message = Sheet1.Range("U3")
    full_name = Sheet1.Range("E" & row_number)
    email_address = Sheet1.Range("F" & row_number)
    supervisor_email = Sheet1.Range("H" & row_number)
    date_time = Sheet1.Range("B" & row_number)
    computer_used = Sheet1.Range("C" & row_number)
    device_description = Sheet1.Range("J" & row_number)
    mail_body_message = Replace(mail_body_message, "replace_name_here", full_name)
    mail_body_message = Replace(mail_body_message, "replace_email_here", email_address)
    mail_body_message = Replace(mail_body_message, "replace_supemail_here", supervisor_email)
    mail_body_message = Replace(mail_body_message, "replace_date_here", date_time)
    mail_body_message = Replace(mail_body_message, "replace_compter_here", computer_used)
    mail_body_message = Replace(mail_body_message, "replace_device_here", device_description)
        MsgBox mail_body_message
        'Call SendEmail(Sheet1.Range("F" & row_number), Sheet1.Range("H" & row_number), "this is a test subject", mail_body_message)

        Last_Row_IN_Column_F = Sheet1.Range("F1000").End(xlUp).Row

Loop Until row_number = Last_Row_IN_Column_F

MsgBox Last_Row_IN_Column_F



End Sub

1 个答案:

答案 0 :(得分:2)

整理一下代码,我相信以下内容将帮助您实现所需的结果:

 Sub SendEmail(what_address As String, carbon_copy As String, subject_line As String, mail_body_message As String)
    Dim olApp As Outlook.Application: Set olApp = CreateObject("Outlook.Application")
    Dim olMail As Outlook.MailItem: Set olMail = olApp.CreateItem(olMailItem)
    olMail.To = what_address
    olMail.CC = carbon_copy
    olMail.Subject = subject_line
    olMail.Body = mail_body_message
    olMail.Send 'Send email
    'olMail.Display 'if you want to see the email before you decide to click send or not!
End Sub

Sub SendMassEmail()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim row_number As Long
Dim mail_body_message As String
row_number = 1
Last_Row_IN_Column_F = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
Do
    row_number = row_number + 1
    mail_body_message = ws.Range("U3").Text
    mail_body_message = Replace(mail_body_message, "replace_name_here", ws.Range("E" & row_number))
    mail_body_message = Replace(mail_body_message, "replace_email_here", ws.Range("F" & row_number))
    mail_body_message = Replace(mail_body_message, "replace_supemail_here", ws.Range("H" & row_number))
    mail_body_message = Replace(mail_body_message, "replace_date_here", ws.Range("B" & row_number))
    mail_body_message = Replace(mail_body_message, "replace_compter_here", ws.Range("C" & row_number))
    mail_body_message = Replace(mail_body_message, "replace_device_here", ws.Range("J" & row_number))
    'MsgBox mail_body_message
    Call SendEmail(ws.Range("F" & row_number).Text, ws.Range("H" & row_number).Text, "this is a test subject", mail_body_message)
Loop Until row_number = Last_Row_IN_Column_F

MsgBox "Emails Sent Completed", vbInformation
End Sub