尝试保存为Outlook MailItem，获取运行时错误“287”Excel VBA

我的部门使用Access来创buildPDF并在通用电子邮件模板中发送文档。 他们目前通过打开模板，手动附加PDF，然后发送它。 电子邮件发送后，他们然后将.msg文件从Outlook发送文件夹中单独拖动到每个客户端文件夹。

我写了一个Excel VBA读取每个单元格中的电子邮件地址，通过path附加PDF，发送电子邮件，然后自动保存.msg。

问题： .SaveAs函数不会为我工作，因为我得到运行时错误287.如果我把.SaveAs离开，一切工作（附件，.Display，。发送等）。

我所做的事情：我引用了Microsoft Outlook 12.0对象，并尝试了早期和晚期绑定。 这是在工作站上，他们使用Excel 2010，但是当我用Excel 2013（Outlook 15.0对象）在家用电脑上尝试时，它工作正常。

我很困惑…另外，这里是一个错误和行的屏幕截图的链接： http : //imgur.com/yTo41s5

Sub CreateNewMessage() Dim OutApp As Object Dim objOutlookMsg As Object Dim Pth As String Dim cell As Range Pth = "some\path\" 'Path to PDF folder Application.ScreenUpdating = False Set OutApp = CreateObject("Outlook.Application") 'Set Outlook application On Error GoTo Cleanup 'For Loop to find each cell of e-mails For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants) 'Finds e-mail values @ and . for cell value If cell.Value Like "?*@?*.?*" Then Set objOutlookMsg = OutApp.CreateItem(0) On Error GoTo Cleanup With objOutlookMsg .To = cell.Value .Subject = Cells(cell.Row, "C").Value & " - Approval Letter" .body = "Pre-worded e-mail template" .Attachments.Add Pth & Dir(Pth & Cells(cell.Row, "C") & "\" & .Subject & ".msg" 'Attach PDF 'This next SaveAs line throws the error, or if I keep the error handler in, it goes to Cleanup and nothing happens .SaveAs "Path\To\Save\Folder" & Cells(cell.Row "C") & _ "\" & .Subject & ".msg" 'Save MailItem to folder .Display '.Send End With On Error GoTo 0 Set objOutlookMsg = Nothing End If Next cell Cleanup: Set OutApp = Nothing Application.ScreenUpdating = True End Sub 

Answer 1

我看到你的代码在Cells(cell.Row, "C")有“，”，所以这只是上面的一个错字，

但是你还没有改变默认的行来匹配你的path（在你的图像中）

 "Path\To\Save\Folder"