将文件夹中的单个附件发送给不同的人员 [英] Email a single attachment from folder of files each to a different person

问题描述

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

下面的代码集有两个问题：
1）我有3个Excel文件中的数据列：一个用于主题，一个用于发送给电子邮件地址，第三个用于存储要附加附件的文件路径。

下面的代码不允许一组预先确定的主题参数。它也使用ROWS？对于filepath字段而不是像发送到的列那样的列？这样令人困惑。

  Sub Send_Files（）
 Dim OutApp作为对象
 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 
结束
 
设置sh =表（Sheet1）
 
设置OutApp = CreateObject（Outlook.Application）
 
对于每个单元格在sh.Columns（B）。Cells.SpecialCells（xlCellTypeConstants）
 
'输入每行中的C：Z列中的路径/文件名称
设置rng = sh.Cells（cell.Row，1）.Range（C1：Z1）
 
如果cell.Value像?*@?*.?*和_ 
 Application.WorksheetFunction.CountA（rng）> 0然后
设置OutMail = OutApp.CreateItem（0）
 
使用OutMail 
 .to = cell.Value 
 .Subject =Testfile
。 Body =Hi& cell.Offset（0，-1）.Value 
 
对于每个FileCell在rng.SpecialCells（xlCellTypeConstants）
如果Trim（FileCell）<> 然后
如果Dir（FileCell.Value）<> 然后
 .Attachments.Add FileCell.Value 
 End If 
 End If 
 Next FileCell 
 
 .Send'或使用.Display 
结束
 
设置OutMail =没有
结束如果
下一个单元格
 
设置OutApp =没有
应用程序
。 EnableEvents = True 
 .ScreenUpdating = True 
 End with 
 End Sub 
  

解决方案

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

  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 
 
设置olApp = CreateObject（Outlook.Application）
 
直到IsEmpty（Cells（iRow，1））
 
 Recip = Cells （iRow，1）.Value 
 Subject = Cells（iRow，2）.Value 
 Atmt = Cells（iRow，3）.Value'Attachment Path 
 
设置olMail = olApp .CreateItem（0）
 
使用olMail 
设置olRecip = .Recipients.Add（Recip）
 .Subject =主题
 .Body =嗨
。显示
设置ol Atmt = .Attachments.Add（Atmt）
 olRecip.Resolve 
结束
 
 iRow = iRow + 1 
 
循环
 
 Set olApp = Nothing 
 Exit Sub 
 
 End Sub 
  

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?

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.

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

解决方案

Here is quick example, assuming 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

这篇关于将文件夹中的单个附件发送给不同的人员的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！