VBA Массовая электронная почта

Question

Я новичок в 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

Answer 1

Немного исправил ваш код, я верю, что следующее поможет вам достичь желаемого результата:

 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