如何修改Outlook VBA代码将里程添加至约会备注？

需求说明 #

现有一段Outlook VBA代码，支持手动给日历约会、会议、联系人或任务添加/修改里程（支持加减运算），需要新增功能：将最终设置的里程同步到约会/会议的备注栏中。

原代码 #

Sub AddMileage()

'=================================================================
'Description: Outlook macro to set the mileage for an appointment,
'             meeting, contact or task item.
'             It can also add and subtract mileage if a mileage
'             has already been set.
'
'author : Robert Sparnaaij
'version: 1.0
'=================================================================
    
    Dim objOL As Outlook.Application
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Set objOL = Outlook.Application
    
    'Get the selected item
    Select Case TypeName(objOL.ActiveWindow)
        Case "Explorer"
            Set objSelection = objOL.ActiveExplorer.Selection
            If objSelection.Count > 0 Then
                Set objItem = objSelection.Item(1)
            Else
                result = MsgBox("No item selected. " & _
                            "Please make a selection first.", _
                            vbCritical, "Add Mileage")
                Exit Sub
            End If
        
        Case "Inspector"
            Set objItem = objOL.ActiveInspector.CurrentItem
            
        Case Else
            result = MsgBox("Unsupported Window type." & _
                        vbNewLine & "Please make a selection" & _
                        " or open an item first.", _
                        vbCritical, "Add Mileage")
            Exit Sub
    End Select

    Dim CurrentMileage As String
    Dim Operator As String
    Dim Mileage As String
    
    'Get the object class
    If objItem.Class = olAppointment _
    Or objItem.Class = olContact _
    Or objItem.Class = olTask _
    Then
    
        'Get the mileage
        If objItem.Mileage > "" Then
            CurrentMileage = objItem.Mileage
        Else
            CurrentMileage = 0
        End If
            
        'Set mileage dialog
        Dim Explanation As String
        Explanation = "You can use the operators + and - to add or subtract from " & _
                        "the currently recorded mileage, respectively." _
                        & vbNewLine & vbNewLine & _
                        "If you do not specify an operator, your input will " & _
                        "overwrite the current value."
        
        result = InputBox("Currently recorded mileage for the selected item: " & _
                    CurrentMileage & vbNewLine & vbNewLine & Explanation, "Add Mileage")
        
        'User canceled dialog
        If result = "" Then
            Exit Sub
        End If
            
        'Determine if an operator is set and the possibility of doing calculations
        Operator = Left(result, 1)
        If Len(result) > 1 Then
            Mileage = Right(result, Len(result) - 1)
            If Operator = "+" Or Operator = "-" Then
                If IsNumeric(CurrentMileage) = True And IsNumeric(Trim(Mileage)) = True Then
                    Dim intCurrentMileage As Integer
                    Dim intMileage As Integer
                    
                    intCurrentMileage = CurrentMileage
                    intMileage = Mileage
                Else
                    result = MsgBox("Sorry, your current mileage and/or provided " & _
                                        "mileage isn't numeric so calculations aren't possible.", _
                                        vbCritical, "Add Mileage")
                    Exit Sub
                End If
            End If
        End If
            
        'Set the new mileage
        objItem.Mileage = result
        
        objItem.Save
    
    Else
        result = MsgBox("No Appointment, Contact or Task item selected. " & _
            vbNewLine & "Please make a valid selection first.", _
            vbCritical, "Add Mileage")
        Exit Sub
    End If
    
    'Cleanup
    Set objOL = Nothing
    Set objItem = Nothing
    Set objSelection = Nothing
       
End Sub

修改后的完整代码 #

Sub AddMileage()

'=================================================================
'Description: Outlook macro to set the mileage for an appointment,
'             meeting, contact or task item.
'             It can also add and subtract mileage if a mileage
'             has already been set.
'             新增：同步里程至约会/会议备注栏
'
'author : Robert Sparnaaij
'version: 1.1
'=================================================================
    
    Dim objOL As Outlook.Application
    Dim objSelection As Outlook.Selection
    Dim objItem As Object
    Set objOL = Outlook.Application
    
    'Get the selected item
    Select Case TypeName(objOL.ActiveWindow)
        Case "Explorer"
            Set objSelection = objOL.ActiveExplorer.Selection
            If objSelection.Count > 0 Then
                Set objItem = objSelection.Item(1)
            Else
                result = MsgBox("未选中任何项目，请先选择一个项目。", _
                            vbCritical, "添加里程")
                Exit Sub
            End If
        
        Case "Inspector"
            Set objItem = objOL.ActiveInspector.CurrentItem
            
        Case Else
            result = MsgBox("不支持当前窗口类型，请选中项目或打开项目后重试。", _
                        vbCritical, "添加里程")
            Exit Sub
    End Select

    Dim CurrentMileage As String
    Dim Operator As String
    Dim Mileage As String
    Dim newMileage As String ' 新增：存储最终计算后的里程值
    
    'Get the object class
    If objItem.Class = olAppointment _
    Or objItem.Class = olContact _
    Or objItem.Class = olTask _
    Then
    
        'Get the mileage
        If objItem.Mileage > "" Then
            CurrentMileage = objItem.Mileage
        Else
            CurrentMileage = 0
        End If
            
        'Set mileage dialog
        Dim Explanation As String
        Explanation = "可以使用+或-运算符，在现有里程基础上进行加减操作。" _
                        & vbNewLine & vbNewLine & _
                        "如果不输入运算符，输入值将直接覆盖当前里程。"
        
        result = InputBox("当前记录的里程：" & _
                    CurrentMileage & vbNewLine & vbNewLine & Explanation, "添加里程")
        
        'User canceled dialog
        If result = "" Then
            Exit Sub
        End If
            
        'Determine if an operator is set and the possibility of doing calculations
        Operator = Left(result, 1)
        If Len(result) > 1 Then
            Mileage = Right(result, Len(result) - 1)
            If Operator = "+" Or Operator = "-" Then
                If IsNumeric(CurrentMileage) = True And IsNumeric(Trim(Mileage)) = True Then
                    Dim intCurrentMileage As Integer
                    Dim intMileage As Integer
                    
                    intCurrentMileage = CurrentMileage
                    intMileage = Mileage
                Else
                    result = MsgBox("当前里程或输入的里程不是数值，无法进行计算。", _
                                        vbCritical, "添加里程")
                    Exit Sub
                End If
            End If
        End If
            
        'Set the new mileage
        Select Case Operator
            Case "+"
                newMileage = CStr(intCurrentMileage + intMileage)
                objItem.Mileage = newMileage
            Case "-"
                newMileage = CStr(intCurrentMileage - intMileage)
                objItem.Mileage = newMileage
            Case Else
                newMileage = result
                objItem.Mileage = newMileage
        End Select
        
        ' ---------- 核心新增：同步里程至约会/会议备注 ----------
        If objItem.Class = olAppointment Then
            ' 追加里程信息到备注，避免覆盖原有内容
            objItem.Body = objItem.Body & vbNewLine & vbNewLine & "里程记录：" & newMileage & " 英里"
            ' 若需要覆盖原有备注，替换为以下代码：
            ' objItem.Body = "里程记录：" & newMileage & " 英里"
        End If
        ' ---------------------------------------------------
        
        objItem.Save
    
    Else
        result = MsgBox("未选中约会、联系人或任务项目，请选择有效项目后重试。", _
            vbCritical, "添加里程")
        Exit Sub
    End If
    
    'Cleanup
    Set objOL = Nothing
    Set objItem = Nothing
    Set objSelection = Nothing
       
End Sub

修改要点说明 #

1. 新增变量newMileage：统一存储最终计算后的里程值，避免重复获取，方便后续同步到备注
2. 添加备注同步逻辑：在设置完里程后、保存项目前，针对约会/会议类项目（olAppointment），将里程信息追加到Body字段（即备注栏）。示例采用追加模式，保留原有备注内容；若需覆盖原有备注，可替换对应代码
3. 中文适配：将弹窗提示和说明文本替换为中文，更符合国内使用习惯

补充说明 #

关于你提到的「计算约会地点间距离」需求，需要调用外部地图API（如高德、百度地图API）实现，这部分需额外添加网络请求逻辑，不属于当前同步备注的范畴。

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