我正在使用Excel电子邮件代码从Excel表中的电子邮件地址和文件名列表中发送带有多个附件的多封电子邮件。
Excel数据库Source Link：https://github.com/sotirop/mergelook
我们的IT团队将MS Excel从MS 2016更新为MS 365，并将操作系统更新为Windows 10。
现在我得到了-
'运行时错误' 287 '：应用程序定义或对象定义的错误'
以线

.To = .To & "; " & ActiveSheet.Cells(row, col).Value

字符串
x1c 0d1x的数据

的
适用于旧版本Excel的代码。

Sub sendEmailWithAttachments()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim myAttachments As Object
Dim row As Integer
Dim col As Integer
Set OutLookApp = CreateObject("Outlook.application")
row = 2
col = 1
ActiveSheet.Cells(row, col).Select
Do Until IsEmpty(ActiveCell)
    workFile = Application.ActiveWorkbook.Path & "\" & "message.oft"
    If FileExists(workFile) Then
        Set OutLookMailItem = OutLookApp.CreateItemFromTemplate(workFile)
    Else
        MsgBox ("message.oft file does not exist in the folder!" & vbNewLine & _
            "Also verify that the name is exactly 'message.oft'." & vbNewLine & _
            "Exiting...")
        Exit Sub
    End If
    
    Set myAttachments = OutLookMailItem.Attachments
    'Do Until IsEmpty(ActiveCell)
    Do Until IsEmpty(ActiveSheet.Cells(1, col))
        With OutLookMailItem
            If ActiveSheet.Cells(row, col).Value = "xxxFINISHxxx" Then
                'MsgBox ("Exiting...")
                Exit Sub
            End If
            If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveCell) Then
                .To = .To & "; " & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "Cc" And Not IsEmpty(ActiveCell) Then
                .CC = .CC & "; " & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "Bcc" And Not IsEmpty(ActiveCell) Then
                .BCC = .BCC & "; " & ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "Reply-To" And Not IsEmpty(ActiveCell) Then
                .ReplyRecipients.Add ActiveSheet.Cells(row, col).Value
            ElseIf ActiveSheet.Cells(1, col).Value = "attachment" And Not IsEmpty(ActiveCell) Then
                attachmentName = ActiveSheet.Cells(row, col).Value
                attachmentFile = Cells(ActiveCell.row, 17).Value & "\" & attachmentName
                If FileExists(attachmentFile) Then
                    myAttachments.Add Cells(ActiveCell.row, 17).Value & "\" & ActiveSheet.Cells(row, col).Value
                Else
                    MsgBox (Attachment & "'" & attachmentName & "'" & " file does not exist in the folder!" & vbNewLine & _
                        "Correct the situation and delete all messages from Outlook's Outbox folder before pressing 'Send Emails' again!" & vbNewLine & _
                        "Exiting...")
                    Exit Sub
                End If
            ElseIf ActiveSheet.Cells(1, col).Value = "xxxignorexxx" Then
                ' Do Nothing
            Else
                .Subject = Replace(.Subject, ActiveSheet.Cells(1, col).Value, ActiveSheet.Cells(row, col).Value)
                'Write #1, .HTMLBody
                .HTMLBody = Replace(.HTMLBody, ActiveSheet.Cells(1, col).Value, ActiveSheet.Cells(row, col).Value)
                'ActiveSheet.Cells(10, 10) = .HTMLBody
            End If
            
            'MsgBox (.To)
        End With
        'Application.Wait (Now + #12:00:01 AM#)
        
        col = col + 1
        ActiveSheet.Cells(row, col).Select
    Loop
    OutLookMailItem.HTMLBody = Replace(OutLookMailItem.HTMLBody, "xxxNLxxx", "<br>")
    OutLookMailItem.send
    col = 1
    row = row + 1
    ActiveSheet.Cells(row, col).Select
Loop
End Sub

型