关于使用VBA发送电子邮件的后续行动

Question

关于使用VBA发送电子邮件的后续行动

这是有关使用VBA发送电子邮件的几条消息的后续内容.

大多数建议使用Outlook,CDO或MAPI:

Set appOL = CreateObject("Outlook.Application") 

Set msgOne = CreateObject("CDO.Message") 

Set mapi_session = New MSMAPI.MAPISession

Run Code Online (Sandbox Code Playgroud)

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

我正在尝试使用Excel来组织工作中的组分配,我无法以任何方式修改其他人的计算机.

有没有更简单的方法从Excel宏发送电子邮件？
我需要的只是消息正文中的一个文本块,没有附件.

我整个星期都在浏览谷歌,MSDN和StackOverflow,而且我被困在一条缓慢的船上无处可去.

Answer 1

Sid*_*out 9

建立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

Run Code Online (Sandbox Code Playgroud)

跟进

谢谢(你的)信息.我已经排除了ShellExecute,因为它将整个参数字符串限制为250个字符,我需要大约2000个消息.但看起来SE是唯一可以在我的情况下工作的选项. - Humanoid1000 7小时前

这是"可怕的(我喜欢JFC说的方式!!!)"我在评论中提到的方式很漂亮:) BTW我只有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

Run Code Online (Sandbox Code Playgroud)

快照

包含消息的文本文件

在此输入图像描述