如何将 Outlook AppointmenItem 数据传递给 Access 表单文本框

Question

我有一个 Access 表单，它将为当前记录创建一个 Outlook AppointmentItem。
AppointmentItem 的 .Start 和 .Categories 派生自表单上的用户输入。
我有一个命令按钮，可以找到并打开 AppointmentItem，以便用户可以对其进行编辑。

用户进行编辑后，我想将编辑后的信息传递给表单控件，以便用户无需打开 AppointmentItem 即可看到更新的开始时间和类别。

我正在为两位数据存储公共变量。我无法弄清楚用 AppointmentItem 中的数据更新变量的过程。

查找现有 AppointmentItem 的代码：

Option Compare Database
Public gdtStart As Date
Public gstrCat As String
Option Explicit

Function FindExistingAppt(strPath As String)
    
    Dim OApp        As Object
    Dim OAppt       As Object
    Dim ONS         As Object
    Dim ORecipient  As Outlook.Recipient
    Dim OFolder     As Object
    Dim sFilter     As String
    
    Const olAppointmentItem = 1
    Dim bAppOpened            As Boolean
    'Initiate our instance of the oApp object so we can interact with Outlook
    On Error Resume Next
    Set OApp = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    If err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
        err.Clear
        Set OApp = CreateObject("Outlook.Application")
        bAppOpened = False    'Outlook was not already running, we had to start it
    Else
        bAppOpened = True    'Outlook was already running
    End If
    On Error GoTo Error_Handler
        
    Set OApp = GetObject(, "Outlook.Application")
    Set ONS = OApp.GetNamespace("MAPI")
        
    Set ORecipient = ONS.CreateRecipient("xxxxxxxxxxxxx")
        
    'my example uses a shared folder but you can change it to your defaul
    Set OFolder = ONS.GetSharedDefaultFolder(ORecipient, olFolderCalendar)
    'use your ID here
    sFilter = "[Mileage] = " & strPath & ""
        
    If Not OFolder Is Nothing Then
        
        Set OAppt = OFolder.Items.Find(sFilter)
        
        If OAppt Is Nothing Then
            MsgBox "Could not find appointment"
        Else
            With OAppt
                .Display
            End With
        End If
    End If

    gdtStart = OAppt.Start
    gstrCat = OAppt.Categories
        
Error_Handler_Exit:
    On Error Resume Next
    If Not OAppt Is Nothing Then Set OAppt = Nothing
    If Not OApp Is Nothing Then Set OApp = Nothing
    Exit Function
     
Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
      "Error Number: " & err.Number & vbCrLf & _
      "Error Source: FindExistingAppt" & vbCrLf & _
      "Error Description: " & err.Description & _
      Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl), _
      vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
    
End Function

下面是来自打开 AppointmentItem 的命令按钮的代码。

Private Sub cmdFindAppt_Click()
'Goes to the OutlookApp module and uses the FindExistingAppt function to look for an appointment that has
'already been created to the Warrants Outlook calendar, and if it found, opens the appointment. After edits are
'made the Appointment Date and Category are updated on the form.
    Call FindExistingAppt(Me.ID)
    Me.ApptDate = gdtStart
    Me.Category = gstrCat
End Sub

如何使用公共变量更新表单控件？
代码运行后，表单控件不会反映存储的公共变量的值。
如果我再次打开 AppointmentItem（使用 FindExistingAppt 代码 - 而不是通过在 Outlook 中正确打开 AppointmentItem），并通过保存或不保存关闭，然后表单控件更新。

Answer 1

这可能不起作用，因为 VBA 代码在 OAppt.Display 之后继续运行。

因此，您所做并保存到 OAppt 的任何更改都不会被读取到您的变量中，因为该函数已经完成。

尝试使用 Modal 参数，这可能会暂停代码，直到 OAppt 关闭。

        With OAppt
          .Display True

https://learn.microsoft.com/en-us/office/vba/api/outlook.appointmentitem.display

在.Display 之前和之后添加Debug.Print 命令和/或断点以查看发生了什么。

Answer 2

您更新这些表单控件的方式应该可以正常工作。 尝试通过调试函数来检查 FindExistingAppt 函数是否确实将值分配给公共变量。 在调试时使用局部窗口观察变量值（gdtStart 和 gstrCat）。

只是分享常见的做法： 如果您的过程/例程没有返回值，那么您可以使用 Sub 关键字而不是 Function 关键字来声明它。