VBA访问-Outlook无法找到通过Access分配任务的名称

时间:2018-11-21 15:21:27

标签: outlook access-vba

我已经成功编写了在Outlook中创建任务的代码。我使用下面的代码在Private Sub OutlookTask_Click()中定义了收件人,并且效果也很好。但是,我需要在Outlook Task表单中添加一些自定义字段。我将代码更改为Private Sub test1_Click()中列出的代码。使用.save将任务分配给我自己可以正常工作。当我分配给其他人时,出现错误,Outlook无法找到该名称。发布的答案效果很好,只需将MyItem更改为OlTask​​。

Private Sub OutlookTask_Click()
Dim OlApp As Outlook.Application
Dim OlTask As Outlook.TaskItem
Dim OlTaskProp As Outlook.UserProperty
Dim OlLocation As Object
Dim OlDelegate As Outlook.Recipient
Dim TName As String


Set OlApp = CreateObject("Outlook.Application")
Set OlTask = OlApp.CreateItem(olTaskItem)
Set OlTaskProp = OlLocation.UserProperties.Find("Mlocation")
TName = Me.Alias
'Set OlDelegate = OlTask.Recipients.Add(TName)

With OLTask
    .Subject = Me.Item
    .StartDate = Me.Start_Date
    .DueDate = Me.Due_Date
    .Status = TStatus
    .Importance = TPriority
    .ReminderSet = True
    .ReminderTime = Me.Due_Date - 3 & " 8:00AM"
    .Body = Me.Description
    .UserProperties("MLocation") = Me.Location


If Me.Alias = "Troy" Then
          .Save
        Else
         .Assign
         Dim myDelegate As Outlook.Recipient
         Set myDelegate = OlTask.Recipients.Add(TName)
         myDelegate.Resolve
    End If

    If myDelegate.Resolved Then
        .Send
    Else
        MsgBox "Name not Found"

    End If
MsgBox "Task Successful"
End Sub



Private Sub test1_Click()

Dim OlApp As Outlook.Application
Dim objFolder As MAPIFolder
Dim OLTask As Outlook.TaskItem
Dim OlItems As Outlook.Items
Dim OlDelegate As Outlook.Recipient
Dim TName As String
Dim TStatus As Integer
Dim TPriority As Integer

Set OlApp = CreateObject("Outlook.Application")
Set objFolder = OlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
Set OlItems = objFolder.Items
Set OLTask = OlItems.Add("IPM.Task.TroyTask")
TName = Me.Alias
Set OlDelegate = OLTask.Recipients.Add(TName)


With OLTask
    .Subject = Me.Item
    .StartDate = Me.Start_Date
    .DueDate = Me.Due_Date
    .Status = TStatus
    .Importance = TPriority
    .ReminderSet = True
    .ReminderTime = Me.Due_Date - 3 & " 8:00AM"
    .Body = Me.Description
    .UserProperties("MLocation") = Me.Location


If Me.Alias = "Troy" Then
    .Save
    Else
        .Assign
        .Send
    End If
End With
MsgBox "Task Successful"
End Sub

1 个答案:

答案 0 :(得分:0)

 

您似乎在未充分准备其内部结构的情况下提交了委托任务,因为Assign()之后紧跟着Send()

If Me.Alias = "Troy" Then
    .Save
Else
    .Assign
    .Send   ' problem
End If

在这种情况下,收件人需要解决。请参阅在工作example中可见的任务委托人名称的解析。我在这里未经测试就采用了它:

If Me.Alias = "Troy" Then
    .Save
Else
    .Assign
    Dim myDelegate As Outlook.Recipient             'added
    Set myDelegate = OlTask.Recipients.Add(TName)   'added
    myDelegate.Resolve                              'added
    If myDelegate.Resolved Then                     'added
        .Send
    Else                                            'added
        'report error here                          'added
    End If                                          'added
End If

Resolve()调用可以在代码中更早的位置,这只是示例中的说明。