Outlook的自定义主题行 [英] Custom Subject line for Outlook

问题描述

我正在通过点击一个按钮来自动化Excel数据库，宏将使用该特定行条目的电子邮件，主题和正文自动发送电子邮件。

例如，我想按按钮，宏会自动发送电子邮件到单元格我们在线发现了一些代码，一旦按下，将发送一封自动电子邮件。但是，主题行不是自定义的。

以下是我正在处理的代码：

  Sub SendReminderMail（）
 Dim OutLookApp As Object 
 Dim OutLookMailItem As Object 
 Dim iCounter As Integer 
 Dim MailDest As String 
 Dim SUBJECT As String 
 
设置OutLookApp = CreateObject（Outlook.application）
设置OutLookMailItem = OutLookApp.CreateItem（0）
 
使用OutLookMailItem 
 .SUBJECT =
对于iCounter = 1 To WorksheetFunction.CountA（列（4））
如果SUBJECT =和Cells（iCounter，4）.Offset（0，-1）=发送提醒然后
 .SUBJECT = Cells（iCounter，6）.Value 
 ElseIf SUBJECT<> 和细胞（iCounter，4）.Offset（0，-1）=发送提醒然后
 SUBJECT = SUBJECT& ; &安培;单元格（iCounter，6）.Value 
 
 End If 
 Next iCounter 
 
 MailDest =
 For iCounter = 1 To WorksheetFunction.CountA（Columns （4））
如果MailDest =和Cells（iCounter，4）.Offset（0，-1）=发送提醒然后
 MailDest = Cells（iCounter，4）.Value 
 ElseIf MailDest<> 和细胞（iCounter，4）.Offset（0，-1）=发送提醒然后
 MailDest = MailDest& ; &安培;单元格（iCounter，4）.Value 
 End If 
 
 Next iCounter 
 
 
 .BCC = MailDest 
 .Body =提醒：时间联系这家公司
。发送
 
结束与
 
设置OutLookMailItem =没有
设置OutLookApp =没有
 
 
 
 End Sub 
  

我目前遇到的问题：

1. 电子邮件发送到正确的电子邮件地址，但主题始终是第六行的主题 - 提醒电子邮件至Andrew。其他联系人不会改变。我需要将每个电子邮件的主题更改为每个不同的联系人。




2. 我注意到，如果我有不同的联系人姓名，电子邮件地址，那么宏只会通过电子邮件发送到具有相同电子邮件的第一个条目，而不是第二个邮件。

任何帮助不胜感激。谢谢

解决方案

所以试着放弃评论，但还是有可能会错过XD

  Sub SendReminderMail（）
 
 Dim OutLookApp As Object 
 Dim OutLookMailItem As Object 
 Dim lastRow As Long 
 Dim iCounter As Long 
 Dim MailDest As String 
 Dim subj As String 
 
 lastRow = ThisWorkbook.WorkSheets（Sheet6）。单元格（Rows.Count，D ）.End（xlUp）.Row'更改工作表
 
对于iCounter = 2 To lastRow 
 
设置OutLookApp = CreateObject（Outlook.application）
设置OutLookMailItem = OutLookApp.CreateItem（0）
 
 With OutLookMailItem 
 subj =
 MailDest =
 
如果Cells（iCounter，3）= 发送提醒然后
 subj = Cells（iCounter，6）.Value 
 MailDest = Cells（iCounter，4）.Value 
 
 .BCC = MailDest 
。 SUBJECT = subj 
 .Body =Re看门人：联系这家公司的时间
。发送
结束如果
 
结束
 
下一步iCounter 
 
结束子
  

I'm working on automating an Excel database so by clicking a button, the macro will automatically send an email using the email, subject, and body for that specific row entry.

For example, I want to press the button and the macro automatically sends out emails to the cells filled in Red to their respective emails with the customized subject.

I found some code online that, once pressed, will send out an automatic email. However, the subject line isn't customized.

Here's the code I'm working on right now:

Sub SendReminderMail()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim iCounter As Integer
Dim MailDest As String
Dim SUBJECT As String

Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)

With OutLookMailItem
.SUBJECT = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(4))
If SUBJECT = "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
.SUBJECT = Cells(iCounter, 6).Value
ElseIf SUBJECT <> "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
SUBJECT = SUBJECT & ";" & Cells(iCounter, 6).Value

End If
Next iCounter

MailDest = ""
For iCounter = 1 To WorksheetFunction.CountA(Columns(4))
If MailDest = "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
MailDest = Cells(iCounter, 4).Value
ElseIf MailDest <> "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
MailDest = MailDest & ";" & Cells(iCounter, 4).Value
End If

Next iCounter


.BCC = MailDest
.Body = "Reminder: Time to contact this firm"
.Send

End With

Set OutLookMailItem = Nothing
Set OutLookApp = Nothing



End Sub

Current problems I'm facing:

1. The email sends out to the correct email addresses but the subject is ALWAYS the subject in the 6th row - "Reminder to email Andrew". It doesn't change for other contacts. I need the subject to change for every email to each different contact.

2. I noticed if I have different contact names but they're listed under the same e-mail address, then the macro will only e-mail to the first entry with the same e-mail, but not the second one.

Any help is appreciated. Thanks

解决方案

So tempted to leave out the comment but there's still a possibility you will miss it XD

Sub SendReminderMail()

Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim lastRow As Long
Dim iCounter As Long
Dim MailDest As String
Dim subj As String

lastRow = ThisWorkbook.WorkSheets("Sheet6").Cells(Rows.Count, "D").End(xlUp).Row 'change worksheet

For iCounter = 2 To lastRow

    Set OutLookApp = CreateObject("Outlook.application")
    Set OutLookMailItem = OutLookApp.CreateItem(0)

    With OutLookMailItem
        subj = ""
        MailDest = ""

        If Cells(iCounter, 3) = "Send Reminder" Then
            subj = Cells(iCounter, 6).Value
            MailDest = Cells(iCounter, 4).Value

            .BCC = MailDest
            .SUBJECT = subj
            .Body = "Reminder: Time to contact this firm"
            .Send
        End If

    End With

Next iCounter

End Sub

这篇关于Outlook的自定义主题行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！