Outlook的自定义主题行

Question

我正致力于自动化Excel数据库，因此通过单击按钮，宏将自动使用该特定行条目的电子邮件，主题和正文发送电子邮件。

例如，我想按下按钮，宏会自动将电子邮件发送到填充红色的单元格，并将其发送到各自的电子邮件中。

我在线发现了一些代码，一旦按下，就会发送一封自动发送的电子邮件。但是，主题行不是自定义的。

这是我现在正在处理的代码：

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

我面临的当前问题：

1. 电子邮件发送到正确的电子邮件地址，但主题始终是第6行中的主题 - ＆＃34;提醒给Andrew＆＃34;发送电子邮件。其他联系人不会改变。我需要针对每个不同联系人的每封电子邮件更改主题。

2. 我注意到如果我有不同的联系人姓名，但他们列在同一个电子邮件地址下，那么宏只会用相同的电子邮件发送到第一个条目，但不会第二个。

感谢任何帮助。感谢

Answer 1

很想遗漏评论，但仍有可能你会错过它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

Answer 2

我相信你正在寻找这一行之间的一切：

With OutLookMailItem

和这一行

End With

为电子表格中的每一行运行ONCE，对吗？对于每一行，如果您有＆＃34;发送提醒＆＃34; Cells(iCounter,4)中的文字，您希望将电子邮件发送给该人。

如果是这种情况 - 由于您将此代码从1一直迭代到6

，这种情况永远不会发生

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

在执行此代码之前

：

.Send

这就是为什么你的.SUBJECT总是＆＃34;提醒给安德鲁发电子邮件。＆＃34; 是＆＃34;提醒您发送电子邮件给Ner，＆＃34;但是这被＃34;提醒通过电子邮件发送给Roo＆＃34;，被＃34; Reminder覆盖给电子邮件安德鲁。＆＃34;

我将您的代码复制到VBA并自行运行，但我不确定它是如何为您工作的，因为我无法让它运行。

如果我上面的建议不是你想要做的，那么你的问题可能在于你. SUBJECT之前的ElseIf 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 '^ period here End If Next iCounter 声明：

.SUBJECT

如果您实际上想要构建OutlookMailItem的{​​{1}}属性，则需要在其前面加一段时间，因为您想引用.SUBJECT - 属性OutlookMailItem，而不是变量SUBJECT（这是非常令人困惑的btw）。

其他一些说明：

您的For循环不需要从1开始，因为这是您的标题行。将来做这样的事情可能会更容易：

lastRow = Range("D" & Rows.Count).End(xlUp).Row

For iCounter = 2 to lastRow step 1
  '/ VBA will iterate through each row until it hits the end
  '/ Assuming column D has data in it to your actual "last row"
Next iCounter

Answer 3

使用F8逐步执行代码。打开本地窗口，观察每个步骤中变量的变化。将光标悬停在黄线或任何前一行上，以查看该点或前一行完成执行时的变量/函数。

特别注意你的主题变量。

这个位也可能没有按照你想要的那样做：

For iCounter = 1 To WorksheetFunction.CountA(Columns(4))

如果我把它放在A到J列中带有一堆值的电子表格中并运行它：

Sub testing()
Dim X
X = WorksheetFunction.CountA(Columns(4))
End Sub

X为0 我怀疑你想要最后一行在D列中有一个值。

Sub lastrow()
Dim X
X = Worksheets("Sheet1").Cells(Rows.Count, "D").End(xlUp).Row
End Sub

这给了我19. D列中的最后一个单元格，带有一个值。你不想数数或数数，因为它不会计算空白。所以你可能有20行数据，但如果只有5行在D列中有一个值，那么你的循环将经历5次，因为你将它基于具有值而不是行的单元格。

主要是，如果您要定期进行这些操作，请在执行此操作时使用F8和View / Locals窗口，您将开始查看出现问题的地方。

然后在尝试修改更大的复杂块之前，创建一个非常简单的子类，就像使用单个代码一样，直到您理解它为止。这将有助于你学会钓鱼。

我没有前景，所以我无法测试你的其余代码，但即使其他一切都很完美，这块也会给你带来麻烦。