升级到 Windows 10 后发送命令出现错误 287答案

【问题标题】：Error 287 on Send command after upgrade to Windows 10升级到 Windows 10 后发送命令出现错误 287
【发布时间】：2017-12-06 10:59:06
【问题描述】：

我有 Excel VBA 代码，可以生成带有附件的 Outlook 电子邮件。

这在 Windows 8.1 中有效，但在 Windows 10 中无效。我已经逐步完成了宏，它一直到最后，生成电子邮件，然后在 OutMail.Send 命令上失败。错误是

运行时错误 287 - 应用程序定义或对象定义错误

这是代码。

Sub batchallocationemail()

'define email & pdf
Dim IsCreated As Boolean
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim OutMail As Object

'
' print allocation Macro

'define worksheets
Dim ws As Worksheet
Set ws = Sheets("Caseworkers")
Dim ws2 As Worksheet
Set ws2 = Sheets("Allocation Sheet")
'define range
Dim NameRange As Range
Dim NameRange2 As Range
Dim x As Range
Dim z As Range
Set z = ws2.Range("B1")

Set NameRange = ws.Range("A1:C69")
Set NameRange2 = ws.Range("A2:A69")
Set NameRange3 = ws.Range("C2:C69")

'Selects name from list and pastes into allocation
ws.Select
NameRange.AutoFilter Field:=2, Criteria1:="In"
For Each x In NameRange2.SpecialCells(xlCellTypeVisible)
        x.Copy
        ws2.Select
        Range("B1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        ws2.Select
'CONVERTS ACTIVE SHEET TO PDF AND EMAILS IT
        ' Define Title
        Title = Range("B1").Value
        ' Define PDF filename
        Title = "Allocation Sheet for " & Range("B1").Value
        PdfFile = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & Title & ".pdf"
  ' Export activesheet as PDF
        With ActiveSheet
            .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End With
' Use already open Outlook if possible
        On Error Resume Next
        Set OutlApp = GetObject(, "Outlook.Application")
        If Err Then
            Set OutlApp = CreateObject("Outlook.Application")
            IsCreated = True
        End If
        OutlApp.Visible = True
        On Error GoTo 0

' Prepare e-mail with PDF attachment
        Set OutMail = OutlApp.CreateItem(0)
        With OutMail

' Prepare e-mail
            OutMail.Subject = Title
            OutMail.To = x.Offset(0, 2).Value ' <-- Put email of the recipient here
            OutMail.CC = x.Offset(0, 3).Value ' <-- Put email of 'copy to' recipient here
            OutMail.Body = "Hello," & vbLf & vbLf _
            & "Please see your attached allocation sheet in PDF format." & vbLf & vbLf _
            & "Kind Regards," & vbLf _
            & Application.UserName & vbLf & vbLf
            OutMail.Attachments.Add PdfFile
        ' Try to send
            Application.Visible = True
            OutMail.Display
            OutMail.Send
        End With

    ' Quit Outlook if it was not already open
        If IsCreated Then OutlApp.Quit

    ' Release the memory of object variable
        Set OutMail = Nothing
        Set OutlApp = Nothing
    Next x

End Sub

【问题讨论】：

标签： vba excel outlook

【解决方案1】：

对不起，我想我已经解决了。我昨晚浏览了几个小时后早些时候发布了这个，但我似乎明白了。而不是 .Send 我使用 Application.SendKeys "%s" 这是一个快捷方式。这似乎可以正确发送电子邮件。

【讨论】：