VBA代码修改需求：合并非空单元格值发送单封会议邀请

需求说明 #

原代码会遍历指定列，每遇到非空单元格就发送单独的Outlook会议邀请。现需调整为：收集所有非空单元格的值，仅发送一封会议邀请，主题格式为「第一个单元格值至最后一个单元格值」，正文按顺序列出所有非空单元格的值。

修改后的代码 #

Sub SendSingleMeetingInvite()
    Dim OL As Outlook.Application, Appoint As Outlook.AppointmentItem
    Dim ES As Worksheet, WB As ThisWorkbook
    Dim r As Long, i As Long
    Dim nonEmptyVals As Collection
    Dim firstVal As String, lastVal As String
    Dim bodyText As String
    Dim meetingStart As Date
    
    ' 初始化对象
    Set WB = ThisWorkbook
    Set ES = WB.Sheets("Automatic Email Reminder")
    Set nonEmptyVals = New Collection
    Set OL = New Outlook.Application
    
    ' 获取数据区域最后一行
    r = ES.Cells(Rows.Count, 1).End(xlUp).Row
    
    ' 遍历行，收集所有非空单元格值及会议开始时间（取第一个非空行的时间）
    For i = 4 To r
        If ES.Cells(i, 6) <> "" Then ' 第6列为目标列，可根据需求修改（5=M&C,6=CP,7=Objection）
            nonEmptyVals.Add ES.Cells(i, 6).Value
            ' 仅记录第一个非空行的会议开始时间，可根据需求调整
            If nonEmptyVals.Count = 1 Then
                meetingStart = ES.Cells(i, 8).Value
            End If
        End If
    Next i
    
    ' 若有非空值，生成会议邀请
    If nonEmptyVals.Count > 0 Then
        firstVal = nonEmptyVals(1)
        lastVal = nonEmptyVals(nonEmptyVals.Count)
        
        ' 构建正文内容
        bodyText = "以下是所有相关项：" & vbCrLf & vbCrLf
        For i = 1 To nonEmptyVals.Count
            bodyText = bodyText & i & ". " & nonEmptyVals(i) & vbCrLf
        Next i
        
        Set Appoint = OL.CreateItem(olAppointmentItem)
        With Appoint
            .Subject = firstVal & "至" & lastVal
            .RequiredAttendees = "example@email.com" ' 替换为实际参会邮箱
            .Start = meetingStart
            .Duration = 5 ' 会议时长，可修改
            .ReminderMinutesBeforeStart = 2880 ' 提前48小时提醒，可修改
            .Body = bodyText
            .MeetingStatus = olMeeting
            .Send ' 若需先预览再发送，可改为.Display
        End With
    Else
        MsgBox "未找到非空单元格，无需发送会议邀请。"
    End If
    
    ' 释放对象
    Set Appoint = Nothing
    Set OL = Nothing
    Set nonEmptyVals = Nothing
    Set ES = Nothing
    Set WB = Nothing
End Sub

关键修改点 #

• 新增Collection对象统一收集所有非空单元格值，避免逐行创建会议邀请
• 提取第一个和最后一个非空值，用于构建符合要求的会议主题
• 循环拼接所有非空值到正文，按序号排列便于阅读
• 取第一个非空行的会议开始时间（若需统一设置固定时间，可直接替换meetingStart为指定日期）
• 增加空值判断，无有效数据时弹出提示，避免无效操作

内容的提问来源于stack exchange，提问作者Keivn