英文:
Outlook VBA to add calculated mileage to the appointment notes
问题
以下是代码的中文翻译部分:
Sub AddMileage()
'=================================================================
'描述:Outlook宏用于设置约会、会议、联系人或任务项的里程。
' 它还可以添加和减少里程,如果已经设置了里程。
'
'作者:Robert Sparnaaij
'版本:1.0
'网站: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
'获取选定的项目
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("不支持的窗口类型。" & _
vbNewLine & "请先进行选择" & _
"或打开项目。", _
vbCritical, "添加里程")
Exit Sub
End Select
Dim CurrentMileage As String
Dim Operator As String
Dim Mileage As String
'获取对象类别
If objItem.Class = olAppointment _
Or objItem.Class = olContact _
Or objItem.Class = olTask _
Then
'获取里程
If objItem.Mileage > "" Then
CurrentMileage = objItem.Mileage
Else
CurrentMileage = 0
End If
'设置里程对话框
Dim Explanation As String
Explanation = "您可以使用操作符+和-来添加或减去" & _
"当前记录的里程," & _
"如果您没有指定操作符,您的输入将覆盖当前值。"
result = InputBox("所选项目的当前记录里程:" & _
CurrentMileage & vbNewLine & vbNewLine & Explanation, "添加里程")
'用户取消对话框
If result = "" Then
Exit Sub
End If
'确定是否设置了操作符以及是否可以进行计算
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
'设置新的里程
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("未选择约会、联系人或任务项目。" & _
vbNewLine & "请先进行有效的选择。", _
vbCritical, "添加里程")
Exit Sub
End If
'清理
Set objOL = Nothing
Set objItem = Nothing
Set objSelection = Nothing
End Sub
希望这有助于您理解和使用该VBA代码。如果您需要任何进一步的帮助,请随时告诉我。
英文:
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
答案1
得分: 0
你需要设置预约项的 Body 或 RTFBody 属性。Body
属性设置表示 Outlook 项纯文本正文的字符串。RTFBody
属性设置表示Microsoft Outlook 项正文的富文本格式的字节数组。例如,要复制预约备注部分的信息,您可以使用以下代码:
'设置新的里程数
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
英文:
> 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
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库,让每个人都能够通过互相帮助和分享经验来进步。
评论