跟进使用VBA发送邮件

Posted 2023-03-15

技术标签:

【中文标题】跟进使用VBA发送邮件【英文标题】：Follow up about using VBA to send e-mail 【发布时间】：2012-05-09 05:13:17 【问题描述】：

这是几篇关于使用 VBA 发送电子邮件的后续消息。

大多数建议使用 Outlook、CDO 或 MAPI：

Set appOL = CreateObject("Outlook.Application") 

Set msgOne = CreateObject("CDO.Message") 

Set mapi_session = New MSMAPI.MAPISession

但显然 Outlook 会要求我更改我们的工作组安全设置，而 CDO 和 MAPI 会要求我添加 DLL 或其他东西。

我正在尝试使用 Excel 来组织工作中的小组作业，但我无法以任何方式修改其他人的计算机。

有没有更简单的方法从 Excel 宏发送电子邮件？我需要的只是邮件正文中没有附件的一段文本。

我整个星期都在翻阅 Google、MSDN 和 ***，但我被困在一条无处可去的慢船上。

【问题讨论】：

【参考方案1】：

在 Marc 提到的基础上，这是一个久经考验的版本。

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Sub SendMail()
    Dim objMail As String
    Dim oMailSubj, oMailTo, oMailBody As String

    On Error GoTo Whoa

    oMailSubj = "YOUR SUBJECT GOES HERE"
    oMailTo = "ABC@ABC.COM"
    oMailBody = "BLAH BLAH!!!!"
    objMail = "mailto:" & oMailTo & "?subject=" & oMailSubj & "&body=" & oMailBody

    ShellExecute 0, vbNullString, objMail, vbNullString, vbNullString, vbNormalFocus

    Application.Wait (Now + TimeValue("0:00:03"))
    Application.SendKeys "%s"

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

跟进

感谢您的信息。我已经排除了 ShellExecute，因为它将整个参数字符串限制为 250 个字符，而我需要大约 2000 个字符来发送消息。但看起来 SE 是在我的情况下真正可行的唯一选择。 – Humanoid1000 7 小时前

这是我在下面的 cmets 中提到的“糟糕（我喜欢 JFC 所说的方式！！！）”方式，效果很好 :) 顺便说一句，我只有 Outlook 作为我的默认客户端，所以我已经用它测试过了。

代码

Option Explicit

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub SendMail()
    Dim objMail As String
    Dim oMailSubj As String, oMailTo As String
    Dim i As Long
    Dim objDoc As Object, objSel As Object, objOutlook As Object
    Dim MyData As String, strData() As String

    On Error GoTo Whoa

    '~~> Open the txt file which has the body text and read it in one go
    Open "C:\Users\Siddharth Rout\Desktop\Sample.Txt" For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)

    Sleep 300

    oMailSubj = "YOUR SUBJECT GOES HERE"
    oMailTo = "ABC@ABC.COM"
    objMail = "mailto:" & oMailTo & "?subject=" & oMailSubj

    ShellExecute 0, vbNullString, objMail, vbNullString, vbNullString, vbNormalFocus

    Sleep 300

    Set objOutlook = GetObject(, "Outlook.Application")
    '~~> Get a Word.Selection from the open Outlook item
    Set objDoc = objOutlook.ActiveInspector.WordEditor
    Set objSel = objDoc.Windows(1).Selection

    objDoc.Activate

    Sleep 300

    For i = LBound(strData) To UBound(strData)
        objSel.TypeText strData(i)
        objSel.TypeText vbNewLine
    Next i

    Set objDoc = Nothing
    Set objSel = Nothing

    '~~> Uncomment the below to actually send the email
    'Application.Wait (Now + TimeValue("0:00:03"))
    'Application.SendKeys "%s"

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

快照

包含消息的文本文件

发送前的电子邮件

【讨论】：

如果我记得 mailto 协议作为对正文长度的限制。（不超过 512 个字符）。如果我错了，请纠正我。感谢您的信息。我已经排除了 ShellExecute，因为它将整个参数字符串限制为 250 个字符，而我需要大约 2000 个字符来发送消息。但看起来 SE 是唯一适用于我的情况的选项。悉达多，我相信你的代码中有错字。 objMail 行应该有字符串“&body=”。（注意与号）我对此进行了更深入的研究，并发现了一个有趣的解决方法来解决 250 字符的限制。对于那些使用 Outlook Express 的人来说，这个家伙将一个巨大的参数字符串放在一个文件中，然后将文件名而不是参数字符串传递给 ShellExecute。这很聪明，但仅适用于 Outlook Express，而不适用于 Outlook，因为 Outlook 使用无法轻松手动创建的二进制文件。 vbnet.mvps.org/index.html?code/shell/shellexecute.htm @Humanoid1000：是的，这是一个我已经纠正的错字。关于你的字符限制，我有一个“可怕”的想法；）给我 15 分钟。很快就会更新帖子。【参考方案2】：

您或许可以使用Shell 命令。