将文件夹中的单个附件通过电子邮件发送给其他人

我有一个包含50个文件的文件夹，我有一个包含50个电子邮件地址的列表。 每个文件都转到不同的电子邮件地址。 有没有办法编写一个macros来执行这个任务？

下面这组代码的问题是双重的：1）我有一个Excel文件中的3列数据：一个用于主题，一个用于发送电子邮件地址，第三个用于FILE PATH的文件path被附加存储。

下面的代码不允许预先确定的一组主题参数。 它也使用ROWS？ 为文件path字段，而不是像发送到一个列？ 很混乱

Sub Send_Files() 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 

Answer 1

这里是一个简单的例子，假设col A = Email, Col B = Subject & Col C = Path

 Option Explicit Sub Example() Dim olApp As Object Dim olMail As Object Dim olRecip As Object Dim olAtmt As Object Dim iRow As Long Dim Recip As String Dim Subject As String Dim Atmt As String iRow = 2 Set olApp = CreateObject("Outlook.Application") Do Until IsEmpty(Cells(iRow, 1)) Recip = Cells(iRow, 1).Value Subject = Cells(iRow, 2).Value Atmt = Cells(iRow, 3).Value ' Attachment Path Set olMail = olApp.CreateItem(0) With olMail Set olRecip = .Recipients.Add(Recip) .Subject = Subject .Body = "Hi " .Display Set olAtmt = .Attachments.Add(Atmt) olRecip.Resolve End With iRow = iRow + 1 Loop Set olApp = Nothing Exit Sub End Sub