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