Macro excel未在电子邮件中附加PPT演示文稿

Question

我一直试图将Powerpoint演示文稿附加到宏excel代码中以发送邮件，但当我运行该代码时，它只发送电子邮件正文，而不发送所附文档。

该文档保存在本地文件夹中，因此不应该成为问题。。。

Sub sendEmailsToMultiplePersonsWithMultipleAttachments()

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("Hoja1")
Set OutApp = CreateObject("Outlook.Application")
For Each cell In sh.Columns("A").Cells.SpecialCells(xlCellTypeConstants)
'path/file names are entered in the columns D:M in each row
Set rng = sh.Cells(cell.Row, 1).Range("D1:M1")

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

With OutMail
.To = sh.Cells(cell.Row, 1).Value
.CC = sh.Cells(cell.Row, 2).Value
.Subject = "Boarder Logistics Corporations CHILE"
.Body = sh.Cells(cell.Row, 3).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)

If Trim(FileCell.Value) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell
'.Send
.Display
End With

Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With

End Sub

Answer 1

当我运行代码时，它只发送电子邮件的正文，而不是附件。

您需要检查附件不能添加到邮件项目的条件。在代码中，我看到以下循环，它在单元格上迭代，并检查是否将文件添加为附件的条件：

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)

If Trim(FileCell.Value) <> "" Then
If Dir(FileCell.Value) <> "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

第一点是循环从不在单元格上迭代。

其次，if条件可能为false，因此永远不会附加文件。

第三，Attachments.Add方法在Attachments集合中创建一个新附件。附件的来源可以是一个文件(由带有文件名的完整文件系统路径表示(或构成附件的Outlook项目。因此，请确保在单元格中指定的文件路径是有效的，并且此类文件存在于磁盘上。