将计算的里程添加到预约记录中

Question

我找到了 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
'website: https://www.howto-outlook.com/howto/addmileage.htm
'=================================================================
    
    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
        Select Case Operator
            Case "+"
                objItem.Mileage = intCurrentMileage + intMileage
            Case "-"
                objItem.Mileage = intCurrentMileage - intMileage
            Case Else
                objItem.Mileage = result
        End Select
        
        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

Answer 1

我需要在代码中添加什么才能让它复制我在预约记录中输入的内容？

您需要设置预约项的Body或RTFBody属性。

Body

属性设置一个表示 Outlook 项目的明文正文的字符串。

RTFBody

属性设置一个字节数组，以富文本格式表示 Microsoft Outlook 项目的正文。例如，要复制约会备注部分中的信息，您可以使用以下代码：

        'Set the new mileage
        Select Case Operator
            Case "+"
                objItem.Mileage = intCurrentMileage + intMileage
                objItem.Body = intCurrentMileage + intMileage
            Case "-"
                objItem.Mileage = intCurrentMileage - intMileage
                objItem.Body= intCurrentMileage - intMileage
            Case Else
                objItem.Mileage = result
                objItem.Body= result
        End Select