将文件文件夹中的单个附件通过电子邮件发送给不同的人 [英] Email a single attachment from folder of files each to a different person
问题描述
我有一个包含 50 个文件的文件夹,我有一个包含 50 个电子邮件地址的列表.每个文件都转到不同的电子邮件地址.有没有办法编写一个宏来执行这个任务?
I have a folder with 50 files and I have a list of 50 email addresses. Each file goes to a different email address. Is there a way to write a macro that performs this task?
下面这组代码的问题有两个:1) 我在 Excel 文件中有 3 列数据:一列用于主题,一列用于发送到的电子邮件地址,第三列用于存储要附加的附件的文件路径.
The problem with the set of code below is two-fold: 1) I have 3 COLUMNS of data in an Excel file: One for subject, one for email address to send to, and the third for the FILE PATH of where the attachment to be attached is stored.
下面的代码不允许预先确定的主题参数集.它也使用ROWS??对于文件路径字段而不是像发送到那样的列?好纠结.
The code below does not allow for a pre-determined set of subject arguments. It also uses ROWS?? for the filepath field instead of a column like it does for send to? So confusing.
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
推荐答案
这里有一个简单的例子,假设 col A = Email, Col B = Subject &Col C = 路径
Here is quick example, assuming col A = Email, Col B = Subject & Col C = Path
Option Explicit
Public 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")
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Worksheets("Sheet1")
Do Until IsEmpty(Sht.Cells(iRow, 1))
Recip = Sht.Cells(iRow, 1).Value
Subject = Sht.Cells(iRow, 2).Value
Atmt = Sht.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
End Sub
这篇关于将文件文件夹中的单个附件通过电子邮件发送给不同的人的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!