如何在分类后以指定的时间间隔将邮件移动到文件夹？

Question

我正在尝试使用计时器将所有归类为“已完成”的文件移动到收件箱中名为“已完成”的文件夹中。这应该大约每分钟发生一次。

我得到了不同的错误。我在做什么错了？

我的代码如下：

Public Sub Application_start()
  On Error Resume Next
  Set Explorer = Application.ActiveExplorer
  Dim Mail As Outlook.MailItem
  Dim MoveToThisFolder As Outlook.MAPIFolder



Sub Application_Quit()
  If TimerID <> 0 Then Call DeactivateTimer
End Sub

Private Sub Application_startup()
  MsgBox "Activating the Timer."
  Call ActivateTimer(1) '
End Sub

Private Sub Explorer_SelectionChange()
  Dim obj As Object
  Dim Sel As Outlook.Selection

  Set Mail = Nothing
  Set Sel = Explorer.Selection

  If Sel.Count > 0 Then
    Set obj = Sel(1)
    If TypeOf obj Is Outlook.MailItem Then
      Set Mail = obj
    End If
  End If
End Sub

Private Sub Mail_PropertyChange(ByVal Name As String)
    Dim Ns As Outlook.NameSpace
    Dim Inbox As Outlook.MAPIFolder
    Dim Subfolder As Outlook.MAPIFolder
    Dim SubfolderName As String

    If Name = "COMPLETE" Then
        Set Ns = Application.GetNamespace("MAPI")
        Set Inbox = Ns.GetDefaultFolder(olFolderInbox)
        SubfolderName = Mail.Categories
        If Len(SubfolderName) = 0 Then Exit Sub
        Set Subfolder = Inbox.Folders(completed)
        If Subfolder.EntryID <> Mail.Parent.EntryID Then
            Set MoveToThisFolder = completed
            EnableTimer 500, Me


        end If


    End If
End Sub

Friend Sub TimerEvent()
  DisableTimer
  If Mail Is Nothing Then Exit Sub
  If MoveToThisFolder Is Nothing Then Exit Sub
  Mail.Move MoveToThisFolder
  Set Mail = Nothing
  Set MoveToThisFolder = Nothing
End Sub

我对VBA非常陌生。