vbaoutlookappointment

Outlook VBA to add calculated mileage to the appointment notes


I have found a VBA code to add mileage to each of my calendar appointments. I'd like to also have the code add the mileage to the meeting notes. Full disclosure... I'm certainly not proficient at writing code. What I'm using was copied and pasted from a google search.

Ideally, I'd love it if I had a code to calculate the distance between my appointment locations and automatically add the mileage, but I'm not sure that's possible.

The following code works well to let me enter the mileage. What would I need to add to the code to have it copy what I entered into the appointment notes?

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

Solution

  • What would I need to add to the code to have it copy what I entered into the appointment notes?

    You need to set the Body or RTFBody property of the appointment item. The Body property sets a string representing the clear-text body of the Outlook item. The RTFBody property sets a byte array that represents the body of the Microsoft Outlook item in Rich Text Format. For example, to duplicate the information in the appointment notes section you can use the following code:

            '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