Question

我正在编写一个宏来从Excel工作表发送电子邮件。宏准备了一些报告，然后具有为报告准备电子邮件的功能。一切正常，除非它到达.Send行，它给我一个运行时错误-2147467259。不知道这意味着什么，但会很感激帮助。

以下是该函数的代码：

Function Mail_Reports(ByRef wkDate2 As String, fileDate2 As String, wkNumber2 As String, thisYear2 As String)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
    Dim OutApp As Object
    Dim OutMail As Object
    Dim mailList As String
    Dim i As Long, lstRow As Long, p As Long, addressNum As Long, begRow As Long
    Dim proNam2 As String
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    For i = 1 To 5 Step 1
        mailList = ""
        lstRow = Sheets("Data").Cells(Rows.Count, i).End(xlUp).Row
        addressNum = lstRow - 16
        begRow = lstRow - addressNum
        proNam2 = Sheets("Data").Cells(16, i)
        proNam2 = Replace(proNam2, " ", "")
        For p = 1 To addressNum Step 1
            mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
        Next p
        With OutMail
            .To = mailList
            '.CC = "" remove comma and use this if you want to cc anyone, can be string or variable
            '.BCC = "" remove comma and use this if you want to cc anyone, can be string or variable
            .Subject = "Test"
            .HTMLBody = "<HTML><BODY><Font Face=Calibri(Body)><p>Hi All,</p><p2>Attached to this e-mail is the test file.<p2/><br><br><p3>Best,<p3/></font></BODY></HTML>"
            .attachments.Remove 1
            .attachments.Add "C:\Documents and Settings\test.xlsx"
            .Display
            .Send
    Next i


    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

Answer 1

请你试试吧，

将报告文件保存到本地驱动器
首先使用一个电子邮件地址，因此请删除for循环
只用一个文件/范围/工作簿发送。
删除用于签名的HTML标签等。

代码：

With WB '-- workbook
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = "myname@myname.com"
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Here is a Report on My VBA analysis"
            .Attachments.Add Dest.FullName
            'You can add other files also like this
            '.Attachments.Add ("C:\testmail.txt") '-- .xls
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

根据OP的评论进行更新：

查看您的电子邮件连续循环，每次新书出现时都不必这样做除了您的邮件列表每个工作簿的差异...... 。您可以从邮件工作簿迭代中取出该循环。

For p = 1 To addressNum Step 1
    mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p

Answer 2

我在这里看到的一个问题是你做了以下事情：

Set OutMail = OutApp.CreateItem(0)

在发送循环之外。你应该在这里移动：

[...]
For p = 1 To addressNum Step 1
  mailList = Sheets("Data").Cells(begRow + p, i) & " ; " & mailList
Next p
Set OutMail = OutApp.CreateItem(0)
With OutMail
[...]

我无法评论您的具体错误，因为我不知道您的OutMail对象中有哪些数据。但是，为了帮助您调试，我建议您：

使用With OutMail

End With

设置对Microsoft Outlook 14.0对象库的引用
将OutApp声明为Outlook.Application（Dim OutApp as Outlook.Application）
将OutMail声明为Outlook.MailItem（Dim OutMail as Outlook.MailItem）
按如下方式初始化OutApp：Set OutApp = New Outlook.Application

上述内容不是必需的（除非关闭With OutMail块），但可以帮助您诊断代码问题。

另请注意，如果您使用的是较新版本的Outlook，则可能会阻止安全控件发送其他应用程序（Excel，Word，Access等）：http://support.microsoft.com/kb/263084。

excel VBA从宏发送电子邮件

2 个答案: