Question

我有一个用于处理任何传入项目的Outlook代码，如果传递给定条件，则仅在邮件项目的Outlook日历中创建新约会。

代码不区分邮件项目和会议请求项目。这导致系统在1899年从会议项目创建新会议，而忽略了这一点。

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)

On Error Resume Next
Set ns = Application.Session
arr = Split(EntryIDCollection, ",")


For i = 0 To UBound(arr)
    Set itm = ns.GetItemFromID(arr(i))

    If (itm.Class = olMail) Then

        Set objMail = itm

        If objMail.Subject = "Approved" And objMail.Sender = "x@mail.com" Then

           Set Reg1 = New RegExp

           With Reg1
                   .Pattern = "([0-9]{2})(.)([0-9]{2})(.)([0-9]{4})(\s)(\W)(\s)([0-9]{2})(.)([0-9]{2})(.)([0-9]{4})"
                   .Global = True
           End With

           If Reg1.test(objMail.Body) Then

                Set M1 = Reg1.Execute(objMail.Body)

                For Each m In M1

                Set objAppt = Application.CreateItem(olAppointmentItem)
                Set objInsp = objAppt.GetInspector
                Set objDoc = objInsp.WordEditor
                Set objSel = objDoc.Windows(1).Selection

                Next
            End if
            .....

 End Sub

Answer 1

您需要按以下方式检查传入项目的Class属性：

  If (itm.Class = olMail) Then

    Set objMail = itm
    ...
  End If 

  If (itm.Class = olMeetingRequest) Then

    Set objMeeting = itm
    ...
  End If

Answer 2

在另一个thread的帮助下解决。

Dim itm As Object
Dim oMail As MailItem

If TypeName(itm) = "MailItem" Then

   Set oMail = itm
   ....
End if

Answer 3

根据OP的评论“运行时错误'13'，为itm变量键入不匹配”和解决开发问题，问题的答案可能会解决滥用On Error Resume Next和设置编辑器在每个模块上生成Option Explicit。

编程改变应该是：

Dim itm As Object
Dim objMail As MailItem

代码忽略传入的会议请求

3 个答案: