使用Excel 365发送Outlook电子邮件,使用旧版本的Excel

laawzig2  于 2023-11-20  发布在  其他
关注(0)|答案(2)|浏览(115)

我正在使用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

vc6uscn9

vc6uscn91#

我建议使用MailItem类的Recipients属性来设置收件人,然后调用ResolveAll方法,该方法尝试根据地址簿解析Recipients集合中的所有Recipient对象。例如:

Set myRecipient = MyItem.Recipients.Add("Eugene Astafiev")
 myRecipient.Resolve 
 If myRecipient .Resolved Then 
   myItem.Subject = "Test task" 
   myItem.Display 
 End If

字符串
请参阅How To: Fill TO,CC and BCC fields in Outlook programmatically了解更多信息。

gzszwxb4

gzszwxb42#

扩展我上面的评论:使用To/CC/BCC属性作为中间变量是一个非常糟糕的主意。引入专用变量并构建它们。一旦你退出循环,设置To/CC/BCC属性而不必阅读它们。

vTo = "";
    Do Until IsEmpty(ActiveSheet.Cells(1, col))
      ...
      If ActiveSheet.Cells(1, col).Value = "To" And Not IsEmpty(ActiveCell) 
      Then
         vTo  = vTo  & "; " & ActiveSheet.Cells(row, col).Value
         ...
    Loop
    OutLookMailItem.To = vTo

字符串

相关问题