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

时间:2021-05-29 12:57:33

标签: vba loops email logging

我是新来的,不是很精通,我倾向于在谷歌上搜索我需要的东西并将它们拼凑在一起,所以请不要觉得你把事情简单化会冒犯我。

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

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

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

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

如果 K=1,我在弄清楚如何将班级/日期/时间信息移到 L:N 列(或表中的 11:13)时也遇到问题,如果 K=1,则移到 O:Q 列K=2,如果 K=3,则到 R:T 列,如果 K="",则跳过该行。还尝试使用发送日期填充相应的电子邮件列,因此 If K=1, F=today(), If 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!"

结束子

0 个答案:

没有答案
相关问题