Question

我有一个旧脚本使用Cell值从excel发送多封邮件，第一个单元格是电子邮件地址，第二个是邮件主题，第三个包含邮件正文，它不再工作了！帮助PLZ

Sub CreateMail()

   Dim objOutlook As Object
   Dim objMail As Object
   Dim rngEntry As Range
   Dim rngEntries As Range

   Set objOutlook = CreateObject("Outlook.Application")
   Set rngEntries = ActiveSheet.Range("B:B")

   For Each rngEntry In rngEntries
        Set objMail = objOutlook.CreateItem(0)
        With objMail
            .To = rngEntry.Value
            .Subject = rngEntry.Offset(0, 1).Value
            .Body = rngEntry.Offset(0, 2).Value
           '.Attachments.Add rngEntry.Offset(0, 3).Value
           .Send '.Display or .Save
        End With
   Next rngEntry

   Set objOutlook = Nothing
   Set objMail = Nothing
   Set rngEntry = Nothing
   Set rngEntries = Nothing

End Sub

Answer 1

您的vba代码确实会向B列中的任何名称发送电子邮件。但是，当它遇到没有数据的第一行时，它会尝试发送没有“收件人：”的电子邮件。此修复程序将在命中B列中的空单元格时停止子程序：

Sub CreateMail()

   Dim objOutlook As Object
   Dim objMail As Object
   Dim rngEntry As Range
   Dim rngEntries As Range

   Set objOutlook = CreateObject("Outlook.Application")
   Set rngEntries = ActiveSheet.Range("B:B")

   For Each rngEntry In rngEntries
   If rngEntry.Value <> "" Then '  ADD THIS LINE HERE
        Set objMail = objOutlook.CreateItem(0)
        With objMail
            .To = rngEntry.Value
            .Subject = rngEntry.Offset(0, 1).Value
            .Body = rngEntry.Offset(0, 2).Value
           '.Attachments.Add rngEntry.Offset(0, 3).Value
           .Send '.Display or .Save
        End With
    Else  '  ADD THIS LINE HERE
        Exit Sub  '  ADD THIS LINE HERE
    End If  '  ADD THIS LINE HERE
   Next rngEntry

   Set objOutlook = Nothing
   Set objMail = Nothing
   Set rngEntry = Nothing
   Set rngEntries = Nothing

End Sub

使用VP使用excel单元格值发送多个邮件

1 个答案: