求助：Excel转Outlook邮件正文用if语句实现仅显示有提及项目

Got it, let's break this down for you. You've already nailed the core work—filtering data, counting mentions for your 20 projects, and storing those counts. Now the key is building a dynamic email body that only includes projects with non-zero mentions. Here's how to pull this off with VBA in Excel:

方法1：逐个变量判断（适合变量已单独定义的情况） #

如果你的20个项目提及次数是存储在单独的变量里（比如proj1Count, proj2Count...proj20Count），可以用逐个判断的方式拼接邮件正文：

Sub SendProjectMentionEmail()
    ' --- 替换为你已有的变量定义和赋值逻辑 ---
    Dim proj1Count As Integer, proj2Count As Integer, proj3Count As Integer
    ' ... 继续定义到proj20Count
    proj1Count = 5 ' 示例值，替换为你的统计结果
    proj2Count = 0
    proj3Count = 2
    ' ... 其他项目的赋值
    
    ' 初始化邮件正文
    Dim emailBody As String
    emailBody = "以下是有提及记录的项目统计：" & vbCrLf & vbCrLf
    
    ' 逐个检查项目计数，仅添加非零记录到正文
    If proj1Count > 0 Then
        emailBody = emailBody & "- 项目1：" & proj1Count & "次提及" & vbCrLf
    End If
    If proj2Count > 0 Then
        emailBody = emailBody & "- 项目2：" & proj2Count & "次提及" & vbCrLf
    End If
    If proj3Count > 0 Then
        emailBody = emailBody & "- 项目3：" & proj3Count & "次提及" & vbCrLf
    End If
    ' ... 重复此判断直到proj20Count
    
    ' 处理所有项目均无提及的边界情况
    If emailBody = "以下是有提及记录的项目统计：" & vbCrLf & vbCrLf Then
        emailBody = "当前所有项目均无提及记录。"
    End If
    
    ' 发送邮件（以Outlook为例）
    Dim outlookApp As Object, outlookMail As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
    
    With outlookMail
        .To = "收件人邮箱@yourcompany.com" ' 替换为实际收件人
        .Subject = "项目提及次数统计"
        .Body = emailBody
        .Display ' 先预览邮件，确认后可改为.Send直接发送
    End With
    
    ' 释放对象
    Set outlookMail = Nothing
    Set outlookApp = Nothing
End Sub

方法2：数组批量处理（更高效易维护） #

如果可以把项目名称和对应计数存到数组里，代码会更简洁，也方便后续修改项目数量：

Sub SendProjectMentionEmail_ArrayVersion()
    ' 定义项目名称和计数数组
    Dim projectNames As Variant
    Dim projectCounts As Variant
    
    ' --- 替换为你的实际项目名称和统计结果 ---
    projectNames = Array("项目1", "项目2", "项目3", "项目4", ..., "项目20")
    projectCounts = Array(5, 0, 2, 0, ..., 3) ' 对应每个项目的提及次数
    
    ' 初始化邮件正文
    Dim emailBody As String
    emailBody = "以下是有提及记录的项目统计：" & vbCrLf & vbCrLf
    
    ' 遍历数组，仅添加非零记录
    Dim i As Integer
    For i = LBound(projectNames) To UBound(projectNames)
        If projectCounts(i) > 0 Then
            emailBody = emailBody & "- " & projectNames(i) & "：" & projectCounts(i) & "次提及" & vbCrLf
        End If
    Next i
    
    ' 处理无提及记录的情况
    If emailBody = "以下是有提及记录的项目统计：" & vbCrLf & vbCrLf Then
        emailBody = "当前所有项目均无提及记录。"
    End If
    
    ' 发送邮件
    Dim outlookApp As Object, outlookMail As Object
    Set outlookApp = CreateObject("Outlook.Application")
    Set outlookMail = outlookApp.CreateItem(0)
    
    With outlookMail
        .To = "收件人邮箱@yourcompany.com"
        .Subject = "项目提及次数统计"
        .Body = emailBody
        .Display
    End With
    
    Set outlookMail = Nothing
    Set outlookApp = Nothing
End Sub

关键逻辑说明 #

• 我们先初始化邮件正文的开头，然后通过条件判断筛选出计数大于0的项目，将其信息拼接进正文。
• 额外添加了边界处理：如果所有项目都没有提及，会自动替换为提示文本，避免邮件正文只有空标题。
• 使用vbCrLf来实现换行，让邮件正文格式更清晰。

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