如何创建一系列电子邮件，将文件附加到文件夹中，同时限制任何一封电子邮件中附加的文件数量？

Question

我需要将所选文件夹中的文件附加到 Outlook 电子邮件中。

例如，如果文件数为 15，则应创建 2 封电子邮件。第一封电子邮件包含前 10 个文件，第二封电子邮件包含剩余的 5 个文件。
换句话说，一封邮件最多只能包含10个文件，如果一个文件夹中的文件超过10个，则继续创建新邮件并附加文件，直到全部附加。

以下代码创建了正确数量的电子邮件（如果有 12 个文件，则创建 2 个电子邮件）但将所有文件附加到每封电子邮件（两封电子邮件都包含 12 个文件）。

Sub attach()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        .Title = "Select a Folder"
        sFolder = .SelectedItems(1)
    End With
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(sFolder)
    Set fls = f.Files
    
    Z = 10
    
    For d = 0 To fls.Count - 1 Step 10
    
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        'On Error Resume Next
        With OutMail
            .To = "abc@gmail.com"
            .CC = ""
            .subject = "file"
            
            y = 0
            For Each x In fls
                If y < Z Then
                    .Attachments.Add (sFolder & "\" & x.Name)
                    y = y + 1
                Else
                    Exit For
                End If
            
                Z = Z + 10
            Next
            .Display
        End With
    Next
End Sub

Answer 1

您可以尝试使用Mod函数将两个数相除，returns只取余数，见以下代码：

Z = 10

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

For d = 0 To fls.Count - 1

  If (d Mod 10) == 0 Then
    Set OutMail = OutApp.CreateItem(0)
  End If

  'On Error Resume Next
   With OutMail
      .To = "abc@gmail.com"
      .CC = ""
      .subject = "file"
        
      y = 0

        'set reference to the x file there

        If y < Z Then
          .Attachments.Add (sFolder & "\" & x.Name)
           y = y + 1
        Else
          Exit For
        End If
        
       If (d Mod 9) == 0 Then
          .Display
       End If   
        
    End With

Next

Answer 2

由于fls无法按索引迭代，将文件放入Collection中。一旦你这样做了，逻辑就变得非常简单。下面的代码重点介绍了如何为每封电子邮件获取正确数量的附件。您可以修改它以添加特定于 Outlook 的调用以实际创建电子邮件：

'add the files to a collection so we can iterate by index
Set cFiles = New Collection
   
For Each f In fls
   cFiles.Add sFolder & "\" & f.Name
Next
   
'build our emails
For i = 0 To cFiles.Count - 1
   If i Mod 10 = 0 Then
      Debug.Print "New email"
   End If
   
   Debug.Print "Attachment:  " & cFiles(i + 1)
Next

如何创建一系列电子邮件，将文件附加到文件夹中，同时限制任何一封电子邮件中附加的文件数量？

How to create a series of emails, to attach files in a folder, while limiting the number of files attached to any one email?

email

outlook

vba

file

attachment