Outlook VBA to add calculated mileage to the appointment notes

huangapple go评论71阅读模式
英文:

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

你需要设置预约项的 BodyRTFBody 属性。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

huangapple
  • 本文由 发表于 2023年5月7日 02:23:56
  • 转载请务必保留本文链接:https://go.coder-hub.com/76190470.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定