用vba写代码，发送一个邮件，发个N个人，主题是当前发送N个人

用vba写代码，发送一个邮件，发个N个人，主题是当前发送N个人

下面是使用VBA编写的代码，用于发送一个包含N个收件人的邮件。邮件的主题是"当前发送N个人"，正文是"这是一个测试的正文"。

Sub SendEmailToMultipleRecipients()
    Dim OutlookApp As Object
    Dim MailItem As Object
    Dim Recipients As Object
    Dim RecipientCount As Integer
    Dim i As Integer
    
    ' 创建Outlook应用程序对象
    Set OutlookApp = CreateObject("Outlook.Application")
    
    ' 创建新的邮件项
    Set MailItem = OutlookApp.CreateItem(0)
    
    ' 设置邮件主题和正文
    RecipientCount = 20 ' 更改为实际的收件人数量
    MailItem.Subject = "当前发送" & RecipientCount & "个人"
    MailItem.Body = "这是一个测试的正文"
    
    ' 添加收件人
    Set Recipients = MailItem.Recipients
    
    ' 添加所有收件人
    For i = 1 To RecipientCount
        Recipients.Add "recipient" & i & "@example.com"
    Next i

    ' 解析收件人
    Recipients.ResolveAll
    
    ' 发送邮件
    ' MailItem.Display
    MailItem.Send
    
    ' 释放对象
    Set Recipients = Nothing
    Set MailItem = Nothing
    Set OutlookApp = Nothing
End Sub

在上述代码中，我们使用RecipientCount变量来存储收件人的数量，并根据该数量设置邮件的主题。请根据需要将RecipientCount更改为实际的收件人数量，并将收件人地址替换为实际的地址。在发送邮件之前，取消注释MailItem.Display可以显示邮件，取消注释MailItem.Send可以直接发送邮件。

比如发送的是31个人，第一个邮件的收件人是15个人，主题是当前发送15个人。第二个邮件的收件人是15个人，主题是当前发送15个人。第三个邮件收件人是剩余的1个人，主题是当前发送1个人。正文都是这是一个测试的正文。

Sub SendEmailToMultipleRecipients()
    Dim olApp As Object
    Dim olMail As Object
    Dim olRecipients As Object
    Dim recipientCount As Integer
    Dim recipientsLeft As Integer
    Dim i As Integer
    
    ' 创建 Outlook 应用程序对象
    Set olApp = CreateObject("Outlook.Application")
    
    ' 创建新的邮件项
    Set olMail = olApp.CreateItem(0)
    
    ' 设置邮件主题
    recipientCount = 31  ' 更改为实际的收件人数量
    
    ' 第一个邮件，发送给前15个收件人
    olMail.Subject = "当前发送15个人"
    
    ' 添加收件人
    Set olRecipients = olMail.Recipients
    
    ' 添加前15个收件人
    For i = 1 To 15
        olRecipients.Add "recipient" & i & "@example.com"
    Next i
	
    ' 解析收件人
    olRecipients.ResolveAll
    
    ' 设置邮件正文
    olMail.Body = "这是一个测试的正文"
    
    ' 发送第一封邮件
    'olMail.Display
    olMail.Send
    
    ' 计算剩余收件人的数量
    recipientsLeft = recipientCount - 15
    
    If recipientsLeft > 0 Then
        ' 创建新的邮件项
        Set olMail = olApp.CreateItem(0)
        
        ' 第二个邮件，发送给接下来的15个收件人
        olMail.Subject = "当前发送15个人"
        
        ' 添加收件人
        Set olRecipients = olMail.Recipients
        
        ' 添加接下来的15个收件人
        For i = 16 To 30
            olRecipients.Add "recipient" & i & "@example.com"
        Next i
        
        ' 解析收件人
        olRecipients.ResolveAll
        
        ' 设置邮件正文
        olMail.Body = "这是一个测试的正文"
        
        ' 发送第二封邮件
        'olMail.Display
        olMail.Send
        
        ' 计算剩余收件人的数量
        recipientsLeft = recipientsLeft - 15
        
        If recipientsLeft > 0 Then
            ' 创建新的邮件项
            Set olMail = olApp.CreateItem(0)
            
            ' 第三个邮件，发送给剩余的1个收件人
            olMail.Subject = "当前发送1个人"
            
            ' 添加收件人
            Set olRecipients = olMail.Recipients
            
            ' 添加剩余的1个收件人
            olRecipients.Add "recipient31@example.com"
            
            ' 解析收件人
            olRecipients.ResolveAll
            
            ' 设置邮件正文
            olMail.Body = "这是一个测试的正文"
            
            ' 发送第三封邮件
            'olMail.Display
            olMail.Send
        End If
    End If
    
    ' 释放对象
    Set olRecipients = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

请根据实际需要修改代码，例如更改收件人地址和数量，并取消注释 Display 或 Send 语句以在发送邮件后显示邮件或直接发送邮件。请确保已正确配置 Outlook 以便发送邮件。

#请根据实际需要修改代码，例如更改收件人地址和数量，并取消注释 Display 或 Send 语句以在发送邮件后显示邮件或直接发送邮件。请确保已正确配置 Outlook 以便发送邮件。

接下来，如果我发送的N个人，N大于15个以上，这个代码该怎么写

Sub SendEmailToMultipleRecipients()
    Dim olApp As Object
    Dim olMail As Object
    Dim olRecipients As Object
    Dim recipientCount As Integer
    Dim i As Integer
    
    ' 创建 Outlook 应用程序对象
    Set olApp = CreateObject("Outlook.Application")
    
    ' 创建新的邮件项
    Set olMail = olApp.CreateItem(0)
    
    ' 设置邮件主题和正文
    recipientCount = 31  ' 更改为实际的收件人数量
    olMail.Subject = "当前发送" & recipientCount & "个人"
    olMail.Body = "这是一个测试的正文"
    
    ' 添加收件人
    Set olRecipients = olMail.Recipients
    
    ' 添加所有收件人
    For i = 1 To recipientCount
        olRecipients.Add "recipient" & i & "@example.com"
    Next i

    ' 解析收件人
    olRecipients.ResolveAll
    
    ' 发送邮件
    'olMail.Display
    olMail.Send
    
    ' 释放对象
    Set olRecipients = Nothing
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

接下来，如果我发送的N个人，N大于15个以上，这个代码怎么循环。

Sub SendEmailToMultipleRecipients()
    Dim olApp As Object
    Dim olMail As Object
    Dim olRecipients As Object
    Dim recipientCount As Integer
    Dim maxRecipientsPerEmail As Integer
    Dim numEmailsToSend As Integer
    Dim recipientsLeft As Integer
    Dim i As Integer
    Dim j As Integer
    
    ' 创建 Outlook 应用程序对象
    Set olApp = CreateObject("Outlook.Application")
    
    ' 设置总共的收件人数量和每封邮件最大的收件人数量
    recipientCount = 31  ' 更改为实际的收件人数量
    maxRecipientsPerEmail = 15  ' 可根据需要调整每封邮件的最大收件人数量
    
    ' 计算需要发送的邮件数量
    numEmailsToSend = Application.WorksheetFunction.Ceiling(recipientCount / maxRecipientsPerEmail, 1)
    
    ' 根据需要发送的邮件数量进行循环
    For i = 1 To numEmailsToSend
        ' 创建新的邮件项
        Set olMail = olApp.CreateItem(0)
        
        ' 设置邮件主题和正文
        olMail.Subject = "当前发送" & IIf(i = numEmailsToSend, recipientsLeft, maxRecipientsPerEmail) & "个人"
        olMail.Body = "这是一个测试的正文"
        
        ' 添加收件人
        Set olRecipients = olMail.Recipients
        
        ' 计算当前邮件中收件人的数量
        recipientsLeft = recipientCount - (i - 1) * maxRecipientsPerEmail
        
        ' 添加收件人到当前邮件
        For j = 1 To IIf(recipientsLeft < maxRecipientsPerEmail, recipientsLeft, maxRecipientsPerEmail)
            olRecipients.Add "recipient" & ((i - 1) * maxRecipientsPerEmail + j) & "@example.com"
        Next j
        
        ' 解析收件人
        olRecipients.ResolveAll
        
        ' 发送当前邮件
        'olMail.Display
        olMail.Send
        
        ' 释放对象
        Set olRecipients = Nothing
        Set olMail = Nothing
    Next i
    
    ' 释放 Outlook 应用程序对象
    Set olApp = Nothing
End Sub