0

我有一张这样的桌子

详情| 日期

X1 | 2021 年 6 月 5 日
X2 | 2021 年 5 月 7 日
X3 | 2021 年 6 月 19 日
X4 | 2021 年 5 月 24 日
X5 | 2021 年 6 月 16 日

我可以使用下面的代码发送电子邮件。但我想从本文末尾提到的代码中设置正文（如果没有找到数据，则不会使用 msgbox 发送电子邮件“无法发送电子邮件。未找到数据”）

正文应该是（其中日期 < 今天 + 31）

详情 = X1 日期 = 2021 年 6 月 5 日
详情 = X2 日期 = 2021 年 5 月 7 日
详情 = X4 日期 = 2021 年 5 月 24 日

代码

 Sub Re_minder()
Dim NewMail As Object
Dim mailConfig As Object
Dim fields As Variant
Dim msConfigURL As String

On Error GoTo Err:

'late binding
Set NewMail = CreateObject("CDO.Message")
Set mailConfig = CreateObject("CDO.Configuration")

mailConfig.Load -1
Set fields = mailConfig.fields

With NewMail
    .From = "sender@gmail.com"
    .To = "recipient@gmail.com"
    .CC = ""
    .BCC = ""
    .Subject = "TEST"
    .TextBody = "test"
  
End With

msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

With fields
    .Item(msConfigURL & "/smtpusessl") = True             
    .Item(msConfigURL & "/smtpauthenticate") = 1          
    .Item(msConfigURL & "/smtpserver") = "smtp.gmail.com" 
    .Item(msConfigURL & "/smtpserverport") = 465          
    .Item(msConfigURL & "/sendusing") = 2                 
    .Item(msConfigURL & "/sendusername") = "sender@gmail.com" 
    .Item(msConfigURL & "/sendpassword") = "********"   
    .Update                        
End With
NewMail.Configuration = mailConfig
NewMail.Send

MsgBox "Email sent", vbInformation

Exit_Err:

Set NewMail = Nothing
Set mailConfig = Nothing
End

Err:
Select Case Err.Number
Case -2147220973  
    MsgBox "Connection Error." & vbNewLine & Err.Number & ": " & Err.Description
Case -2147220975  
    MsgBox "Login ID / Password not correct." & vbNewLine & Err.Number & ": " & Err.Description
Case Else   
    MsgBox "Error in sending email." & vbNewLine & Err.Number & ": " & Err.Description
End Select

Resume Exit_Err

End Sub

电子邮件正文代码

For Each r In Intersect(Range("B:B"), ActiveSheet.UsedRange)
    If r.Value < Now() + 31 Then
        body_txt = body_txt & vbCrLf & "DETAILS = " & r.Offset(, -9).Value & "    Date = > " & 
r.Value
    End If
Next r
4

0 回答 0