OutlookのMailItemを保存しようとすると、実行時エラー '287'が表示されるExcel VBA

Question

私の部署はAccessを使用してPDFを作成し、一般的な電子メールテンプレートでドキュメントを送信します。現在、テンプレートを開いてPDFを手動で添付して送信することで、これを実行します。電子メールが送信されたら、.msgファイルをOutlook Sentフォルダから各クライアントフォルダに個別にドラッグします。

Excel VBAを作成して、各セルの電子メールアドレスを読み取って、パスにPDFを添付し、電子メールを送信し、.msgを自動的に保存しました。

問題：私は.SaveAsを残せば、私はランタイムエラーに287すべて他の作品（添付ファイル、.Display、.Sendなど）を取得するよう .SaveAs機能は私のために動作しません。

私が行ったこと：私はMicrosoft Outlook 12.0オブジェクトを参照しました。私は早期バインディングと後期バインディングの両方を試しました。これはワークステーション上にあり、Excel 2010を使用しますが、Excel 2013（Outlook 15.0オブジェクト）を使用して自宅のコンピュータで試してみると機能します。

私は困惑しています

...また、ここでエラーのスクリーンショットとラインへのリンクです：「」Cells(cell.Row, "C")になるようにしたばかりだ私はあなたのコードを持って見 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

は、上記のタイプミス、

は、しかし、あなたは

"Path\To\Save\Folder"