无法使用 VBA 发送电子邮件

Question

我正在创建一个可以自动发送电子邮件的工具。

我已经开始使用以下非常简单的代码来构建它：

Set outlookobj = New Outlook.Application
Set mitem = outlookobj.CreateItem(olMailItem)

With mitem
.To = "A_Valid_Email@email.com"
.Subject = "TEST"
.Body = "test"
.Display
.Send

End With
End Sub

但是，我工作的公司似乎已锁定 .send。电子邮件将创建正常但不会发送。任何人都可以想办法解决这个问题吗？我考虑过使用 .sendkeys "^{ENTER}" 但我知道它们不是做事的好方法。

提前谢谢你 马特

Answer 1

我指的是这个线程：Excel VBA sending mail using Outlook - Send method fails 解决方案如下：

“将 .Send 更改为 .Display 并将 SendKeys "^{ENTER}" 放在 With mimem 行之前。”

您至少可以尝试一下，也许它也适合您。 :)

Answer 2

如果您可以不使用 Outlook，您可以使用 CDO 发送电子邮件。我不确定这是否会解决您的安全问题，但可能值得一试。这是一个例子。

Sub CDO_Mail_Small_Text(ByVal RecipientList As String, ByVal From As String, _
        ByVal Subject As String, ByVal Body As String, ByVal Attachment As String, _
        ByVal cc As String)
    Dim iMsg As Message
    Dim iConf As Configuration
    Dim strbody As String
    Dim Flds As Variant

    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") _
                       = "webmail.zimmer.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With

    With iMsg
        Set .Configuration = iConf
        .To = RecipientList
        .cc = cc
        .From = From
        .Subject = Subject
        .HTMLBody = Body
    End With

    If Attachment <> "" Then
        iMsg.AddAttachment Attachment
    End If

    iMsg.Send

End Sub

顺便说一句，这还有一个额外的好处，就是让您可以欺骗发件人，让它看起来好像来自其他人。我不知道这是否方便，但仅供参考。