I found VBA code to add mileage to each of my calendar appointments. I'd like to also add the mileage to the meeting notes.
I want to calculate the distance between my appointment locations and add the mileage.
The following code lets 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
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