0

我正在编写一个宏来从 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
4

2 回答 2

1

你能试试吗，

  1. 将报告文件保存到本地驱动器
  2. 首先使用一个电子邮件地址，因此删除 for 循环
  3. 只用一个文件/范围/工作簿发送它。
  4. 删除用于签名等的 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
于 2013-01-16T23:07:53.520 回答
1

我在这里看到的一个问题是您执行以下操作：

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 对象。但是，为了帮助您调试，我建议您：

  1. 用一个关闭With OutMail块End With
  2. 设置对 Microsoft Outlook 14.0 对象库的引用
  3. 将 OutApp 声明为 Outlook.Application ( Dim OutApp as Outlook.Application)
  4. 将 OutMail 声明为 Outlook.MailItem ( Dim OutMail as Outlook.MailItem)
  5. 初始化 OutApp 如下：Set OutApp = New Outlook.Application

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

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

于 2013-01-17T02:33:22.700 回答