Question

所以问题是在测试阶段我的公司希望它来自我的电子邮件而不是随机电子邮件。现在，我们希望从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

Answer 1

在你的“With Outmail”中添加：

.SentOnBehalfOfName = "donotreply@company.com"

编码来自我的电子邮件的程序需要更改来自服务器电子邮件的位置......如何？

1 个答案: