因此,在测试阶段,我的公司希望它来自我的电子邮件,而不是随机的电子邮件。现在我们希望从发送电子邮件donotreply@company.com与其他电子邮件发送的信息相同。新的电子邮件将不是真实的(就像我的)。
Public Sub GetDates()
Dim rw As Integer
Dim subj As String
rw = 2
With ActiveSheet
Do Until .Range("A" & rw) = ""
If .Range("M" & rw) = "" Then
If DateAdd("D", 30, Date) = .Range("G" & rw) Then
Call SendEmail(.Range("A" & rw), .Range("B" & rw), 30, .Range("L" & rw), False)
ElseIf DateAdd("D", 15, Date) = .Range("G" & rw) Then
Call SendEmail(.Range("A" & rw), .Range("B" & rw), 15, .Range("L" & rw), False)
ElseIf DateAdd("D", 7, Date) = .Range("G" & rw) Then
Call SendEmail(.Range("A" & rw), .Range("B" & rw), 7, .Range("L" & rw), False)
End If
End If
If Day(Date) = 1 And .Range("G" & rw) < Date And .Range("M" & rw) = "" Then
subj = subj & .Range("A" & rw) & ", " & .Range("B" & rw) & "--" & .Range("C" & rw) & " Report Past Due" & vbCrLf
End If
rw = rw + 1
Loop
If subj <> "" Then
Call SendEmail(subj, "", 0, "supervisor@company.com", True)
Call SendEmail(subj, "", 0, "Secondsupervisor@company.com", True)
End If
End With
End Sub
Public Sub demo_email(lName As String, fName As String, nDays As Integer, sTo As String)
Dim iMsg As Object
Dim iConf As Object
Dim strBody As String
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= ourserverhere"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
strBody = "Hi the testing from CDO" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
With iMsg
Set .Configuration = iConf
.to = StrTo
.CC = ""
.BCC = ""
.From = """ReportdueReminder"" <donotreply@company.com>"
.Subject = "Probation Report/IDP Report Due"
.HTMLBody = strBody
.Send
End With
End Sub
Public Sub SendEmail(lName As String, fName As String, nDays As Integer, sTo As String, lastEmail As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = sTo
If lastEmail Then
.Subject = "Probation Report/IDP Report Due"
.body = lName
Else
.Subject = "Probation Report/IDP Report Due" 'Enter subject line here
.HTMLBody = lName & ", " & fName & " <a href='http://www.websitehere.com'>Report 1</a> / <a href='http://www.otherwebsitehere.com'> Report 2</a> Due in " & nDays & " days" 'Enter body here
End If
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
在您的"With Outmail"中添加:
.SentOnBehalfOfName = "donotreply@company.com"