我是一个新手,但一直在寻找其他解决方案来解决我的问题,所以我对Excel和VBA有些熟悉。我正在尝试找出如何在同事的工作还有7天就要到期时自动通知他们。同一个工作表上有两个单独的表(每个同事一个工作表)。我如何让VBA根据同一个工作表上的两个不同的表发送电子邮件?
例如,Bill有即将到期的治疗计划,他也有即将到期的评估,治疗计划在一个表中,评估在另一个表中,但它们在同一张纸上(Sheet2 Bill)。我希望在治疗计划离到期日还有7天时自动向Bill发送一封电子邮件。我希望在评估离到期日还有7天时自动向Bill发送另一封电子邮件。
这是目前为止我拥有的代码。我没有看到任何错误消息,但我也没有收到任何电子邮件。
谢谢你的帮助!
客户端名称是B列。
Sub email()
Dim r As Range, cell As Range
Dim ws As Worksheet
Dim Mail_Object As Object, Mail_Single As Object
Dim Email_Subject As String, Email_Send_From As String, Email_Send_To As String, _
Email_Cc As String, Email_Bcc As String, Email_Body As String
Set ws = ThisWorkbook.Worksheets("Sheet2 (Bill)")
Set r = ws.Range("F5:F12")
Set Mail_Object = CreateObject("Outlook.Application")
For Each cell In r
If cell.Value <= (Date + 7) And cell.Value >= (Date) Then
Email_Subject = "Treatment plan is due soon"
Email_Send_From = "blahblah@blahblah.blah"
Email_Send_To = "blahblah@blahblah.blah"
Email_Body = "This is an automated reminder that you have a treatment plan due within the next 7 days."
On Error GoTo debugs
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.Body = Email_Body
.send
End With
End If
Next cell
Sub email()
Dim r As Range, cell As Range
Dim ws As Worksheet
Dim Mail_Object As Object, Mail_Single As Object
Dim Email_Subject As String, Email_Send_From As String, Email_Send_To As String, _
Email_Cc As String, Email_Bcc As String, Email_Body As String
Set ws = ThisWorkbook.Worksheets("Sheet2 (Bill)")
Set r = ws.Range("F19:F26")
Set Mail_Object = CreateObject("Outlook.Application")
For Each cell In r
If cell.Value <= (Date + 7) And cell.Value >= (Date) Then
Email_Subject = "Treatment plan is due soon"
Email_Send_From = "blahblah@blahblah.blah"
Email_Send_To = "blahblah@blahblah.blah"
Email_Body = "This is an automated reminder that you have a treatment plan due within the next 7 days."
On Error GoTo debugs
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.To = Email_Send_To
.Body = Email_Body
.send
End With
End With
End If
debugs: If Err.Description <> "" Then MsgBox Err.Description
End Sub
1条答案
按热度按时间mum43rcc1#
1.打开Excel工作簿,然后按ALT + F11打开VBA编辑器。
1.转到插入〉模块并粘贴以下代码: