修改Ron De Bruins电子邮件不同的文件(?)

时间:2014-01-29 16:29:53

标签: email excel-vba outlook vba excel

我正在使用Ron de Bruins代码将许多不同的文件通过电子邮件发送给不同的人,如下所示。但我遇到的问题是,如果B列中存在电子邮件地址且相应的工作簿不存在,它仍然会创建一个电子邮件,但没有附件,因为没有。有谁知道如何修改代码,以便如果工作簿不存在,它不会创建电子邮件?

Sub Send_Files()
'Working in Excel 2000-2013
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range
Dim FileCell As Range
Dim rng As Range

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set sh = Sheets("Sheet1")

Set OutApp = CreateObject("Outlook.Application")

For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

    'Enter the path/file names in the C:Z column in each row
    Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")

    If cell.Value Like "?*@?*.?*" And _
       Application.WorksheetFunction.CountA(rng) > 0 Then
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .to = cell.Value
            .Subject = "Testfile"
            .Body = "Hi " & cell.Offset(0, -1).Value

            For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                If Trim(FileCell) <> "" Then
                    If Dir(FileCell.Value) <> "" Then
                        .Attachments.Add FileCell.Value
                    End If
                End If
            Next FileCell

            .Send  'Or use .Display
        End With

        Set OutMail = Nothing
    End If
Next cell

Set OutApp = Nothing
With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

1 个答案:

答案 0 :(得分:2)

如果文件不存在,您可以设置一个标志转到下一个项目:

   Dim noFile as Boolean

   noFile = True
   For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
     If Trim(FileCell) <> "" Then
       If Dir(FileCell.Value) <> "" Then
         noFile = False
         .Attachments.Add FileCell.Value
       End If
     End If
   Next FileCell

   if Not noFile then .Send

还有其他方法可以做到这一点(例如,参见Sidharth Rout的建议,即在开始创建电子邮件之前检查文件是否存在);我之所以选择上述内容,是因为它可以最大限度地减少现有代码所需的更改量(只需三行,便于查看它们的功能)。

有些人宁愿用hasFile布尔值反转逻辑:

   Dim hasFile as Boolean

   hasFile = False
   For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
     If Trim(FileCell) <> "" Then
       If Dir(FileCell.Value) <> "" Then
         hasFile = True
         .Attachments.Add FileCell.Value
       End If
     End If
   Next FileCell

   if hasFile then .Send