vba - Excel VBA 发送不同的电子邮件并记录电子邮件详细信息

Question

我是新来的，不是很精通，我倾向于用谷歌搜索我需要的东西并将它们拼凑起来，所以请不要觉得你会因为愚蠢而冒犯我。

我正在尝试创建一个电子表格，我可以在其中根据单元格中的条件发送预定的电子邮件，并将这些电子邮件的发送日期记录在表格中 - 希望是相当简单的事情！

目前正在使用Sheet2上的信息表和 Sheet1 上的 3 个文本框，用于每个文本正文以及下面我非常基本的 vba 尝试 - 电子邮件设置为在测试时显示和评论发送。

我确定我已经做了比我需要的更大的一餐，但目标是在 C:E 列中有一个用户输入类、日期和时间。从那里开始，K 列有一个 IF 语句，用于根据 F 是否为空（第 1 封电子邮件）、F 是否有值（第 2 封电子邮件）或 G 是否有值（第 3 封电子邮件）来确定是否发送电子邮件 1、2 或 3 . 就目前而言，我可以在 3 个单独的 subs 上执行此操作，但不能将它们组合起来，可能是因为我试图将“body”引用到同一个 sub 中的不同文本框？下面是电子邮件 1 的 Sub。它目前正在过滤 K 并将数据从表中复制到另一个范围，然后在清除粘贴的范围并返回表之前用作电子邮件列表（可能不必要）。

我遇到了一个问题，如果我单击此 VBA 的按钮并且 K 列中没有“1”，它会选择表中的所有数据并向所有人发送电子邮件。我希望它跳过 C:E 为空的行，并且只通过电子邮件发送在这些单元格中有新输入的“未完成”电子邮件。

如果 K=1，我在弄清楚如何将班级/日期/时间信息移到 L:N 列（或表中的 11:13），如果 K=2 移到 O:Q 列，我也遇到了问题, 如果 K=3 到 R:T 列，如果 K="" 则跳过该行。还尝试使用发送日期填充适当的电子邮件列，因此如果 K=1，F=today()，如果 K=2，G=today()，IF K=3，H=today()。我了解到，将过滤后的单元格复制并粘贴到过滤后的单元格中并不简单。

任何帮助将不胜感激！谢谢你。PS-最终想弄清楚如何删除日志中超过 30 天的日期并相应地移动数据-即，如果电子邮件 1 超过 30 天，则电子邮件 2 的详细信息变为电子邮件 1，因此我们可以维持 3 次罢工30 天保单

Sub EMAIL1()

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=11, Criteria1:= _
    "1"
Range("A3:E3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.copy
Sheets("Sheet1").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Dim i As Integer
Dim name, email, body, subject, copy, class, classdate, classtime As String
Dim OutApp As Object
Dim OutMail As Object

body = ActiveSheet.TextBoxes("TextBox 1").Text

i = 2
'Loop down name column starting at row 2 column 1
Do While Cells(i, 1).Value <> ""
    
    name = Split(Cells(i, 1).Value, " ")(0) 'extract first name
    email = Cells(i, 2).Value

    class = Cells(i, 3).Value
    classdate = Cells(i, 4).Value
    classtime = Cells(i, 5).Value
    
    body = Replace(body, "[Name]", name)
    body = Replace(body, "[Class]", class)
    body = Replace(body, "[Class Date]", classdate)
    body = Replace(body, "[Class Time]", classtime)

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
         .To = email

         .subject = "Non attendance"
         .body = body
         .display
         '.Send
    End With
    
    body = ActiveSheet.TextBoxes("TextBox 1").Text
    
    i = i + 1
Loop

Set OutMail = Nothing
Set OutApp = Nothing

Range("A2:E2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
   Sheets("Sheet2").Select
   

ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=11
    MsgBox "Email(s) Sent!"

结束子

标签： vbaloopsemaillogging