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



因此,在测试阶段,我的公司希望它来自我的电子邮件,而不是随机的电子邮件。现在我们希望从发送电子邮件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"

相关内容

最新更新