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

时间:2012-04-28 21:49:03

标签: excel email vba excel-vba

这是关于使用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&整个星期StackOverflow,我被困在一条缓慢的船上无处可去。

3 个答案:

答案 0 :(得分: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

<强>后续

  
    
      

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

    
  

这是“可怕的(我喜欢JFC说的方式!!! )”我在下面的评论中提到的方式很漂亮:) BTW我只有Outlook作为我的默认客户端所以我已经用它进行了测试。

<强> CODE

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

<强>快照

包含消息

的文本文件

enter image description here

在发送之前发送电子邮件

enter image description here

答案 1 :(得分:5)

您可以使用Shell命令。

Shell("mailto:username@isp.com")

如果Outlook是您的默认电子邮件程序,我认为Windows会正确解释它(它是从Windows RUN对话框中执行的,但不确定是否来自VBA)。试试看。我现在不在Excel前面。

查看“mailto”的参数,了解如何将主题和正文添加到该字符串中。

<强> CORRECTION: 这只会生成电子邮件,但不会发送。无视我的回答。

答案 2 :(得分:0)

这是最终结果:

事实证明,SendMail()在家工作但不在工作,但CreateObject("Outlook.Application")确实在工作。

我的安全设置不是Outlook的问题,这是一个平凡的错字。

无论哪种方式,本页面上都有很多关于此主题丢失的人的好信息。