如何将Outlook传入约会转换为邮件并发送？附VBA代码片段

嘿，我帮你把这个VBA代码补全并优化了，这样就能顺利把Outlook里的会议消息转成邮件发送啦。先看完整的实现代码：

Public Sub ConvertMeetingToEmail(ActiveFolderName As String, Optional TargetFolderPath As String = "")
    Dim myNamespace As Outlook.NameSpace
    Dim targetFolder As Outlook.Folder
    Dim item As Object
    Dim myMtg As Outlook.MeetingItem
    Dim objMsg As MailItem
    
    ' 初始化Outlook命名空间
    Set myNamespace = Application.GetNamespace("MAPI")
    
    ' 定位到指定的根文件夹（比如你的邮箱账户名）
    On Error Resume Next
    Set targetFolder = myNamespace.Folders(ActiveFolderName)
    On Error GoTo 0
    
    ' 如果指定了子文件夹路径，继续定位
    If TargetFolderPath <> "" And Not targetFolder Is Nothing Then
        Dim folderParts() As String
        Dim i As Integer
        folderParts = Split(TargetFolderPath, "\")
        For i = LBound(folderParts) To UBound(folderParts)
            On Error Resume Next
            Set targetFolder = targetFolder.Folders(folderParts(i))
            On Error GoTo 0
            If targetFolder Is Nothing Then
                MsgBox "找不到指定的子文件夹: " & folderParts(i), vbExclamation
                Exit Sub
            End If
        Next i
    End If
    
    ' 检查文件夹是否有效
    If targetFolder Is Nothing Then
        MsgBox "无法定位到指定文件夹，请检查名称是否正确", vbCritical
        Exit Sub
    End If
    
    ' 遍历文件夹中的所有项目
    For Each item In targetFolder.Items
        ' 只处理会议项
        If TypeName(item) = "MeetingItem" Then
            Set myMtg = item
            ' 创建新邮件
            Set objMsg = Application.CreateItem(olMailItem)
            
            ' 复制会议的关键信息到邮件
            With objMsg
                .Subject = "会议转邮件: " & myMtg.Subject
                .To = myMtg.SenderEmailAddress ' 也可替换成会议参会人：myMtg.To
                .CC = myMtg.CC
                .Body = "原会议信息:" & vbCrLf & vbCrLf & _
                        "主题: " & myMtg.Subject & vbCrLf & _
                        "时间: " & myMtg.MeetingStart & " 至 " & myMtg.MeetingEnd & vbCrLf & _
                        "地点: " & myMtg.Location & vbCrLf & vbCrLf & _
                        myMtg.Body
                ' 要直接发送就用.Send，要预览确认就用.Display
                .Display ' 替换为.Send可自动发送
            End With
            
            ' 释放对象
            Set objMsg = Nothing
            Set myMtg = Nothing
        End If
    Next item
    
    MsgBox "会议转邮件处理完成!", vbInformation
    
    ' 释放资源
    Set targetFolder = Nothing
    Set myNamespace = Nothing
End Sub

关键细节说明： #

• 文件夹定位：支持指定根文件夹（比如你的邮箱账户名称）和可选子文件夹路径（用反斜杠\分隔，例如"收件箱\会议通知"）
• 信息同步：把会议的主题、时间、地点、正文都同步到邮件中，若需要更美观的格式，可将.Body替换为.HTMLBody来编写HTML内容
• 发送选项：默认用.Display让你预览邮件，确认后再发送；若要自动发送，直接把.Display改成.Send即可
• 错误防护：加了简单的错误检查，避免因文件夹不存在等问题导致程序崩溃

使用示例： #

如果要处理你的邮箱账户"我的工作邮箱"里的"收件箱\待转会议"文件夹，直接这样调用：

ConvertMeetingToEmail "我的工作邮箱", "收件箱\待转会议"

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