尝试.Save作为Outlook MailItem，获取运行时错误＆＃39; 287＆＃39; Excel VBA

Question

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

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

问题： .SaveAs函数对我不起作用，因为我得到运行时错误287.如果我离开.SaveAs，其他所有工作（附件，。显示，。发送等）进行。

我做过的事情：我引用了Microsoft Outlook 12.0对象，我尝试过早期和晚期绑定。这是在工作站上，他们使用Excel 2010，但当我使用Excel 2013（Outlook 15.0对象）尝试家用计算机时，它可以工作。

我感到困惑......此外，这里还有一个指向错误和行的屏幕截图的链接：

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

我看到你的代码有＆＃34;，＆＃34;在Cells(cell.Row, "C")中，这只是一个错字，

但您还没有更改默认行以匹配您的路径（在您的图片中）

"Path\To\Save\Folder"