tonelm54
asked on
Outlook VBA move olkItem.MessageClass=REPORT.IPM.Note.IPNRN
Got some simple code which was written an example in another question which works great, but when it comes across a read recipt it fails.
When I query the olkItem.MessageClass it gives me REPORT.IPM.Note.IPNRN, so in short everytime I try and move an item of a type 'REPORT.IPM.Note.IPNRN' my code fails.
The code goes through my entire default inbox and moves everything with the completed state, moves to its appropiate folder in Archive.
Any ideas?
Thanks in advance.
When I query the olkItem.MessageClass it gives me REPORT.IPM.Note.IPNRN, so in short everytime I try and move an item of a type 'REPORT.IPM.Note.IPNRN' my code fails.
The code goes through my entire default inbox and moves everything with the completed state, moves to its appropiate folder in Archive.
Any ideas?
Thanks in advance.
Private olkArchiveFolder As Outlook.MAPIFolder
Sub ArchiveCompleted()
Set olkArchiveFolder = OpenOutlookFolder("Archive 2009\Inbox")
ProcessFolder Outlook.Application.Session.GetDefaultFolder(olFolderInbox)
MsgBox "All Done"
End Sub
Sub ProcessFolder(olkFolder As Outlook.MAPIFolder)
Dim olkSubfolder As Outlook.MAPIFolder, olkItem As Object, intCount As Integer
Set olkArchiveFolder = OpenOutlookFolder("Archive 2009" & Mid(olkFolder.FolderPath, InStr(3, olkFolder.FolderPath, "\")))
For intCount = olkFolder.Items.Count To 1 Step -1
Set olkItem = olkFolder.Items.Item(intCount)
If olkItem.FlagStatus = olFlagComplete Then
olkItem.Move olkArchiveFolder '<- the 'IPM.Note works fine, but 'REPORT.IPM.Note.IPNRN' fails
End If
Next
For Each olkSubfolder In olkFolder.Folders
ProcessFolder olkSubfolder
Next
Set olkSubfolder = Nothing
End Sub
Function IsNothing(obj)
If TypeName(obj) = "Nothing" Then
IsNothing = True
Else
IsNothing = False
End If
End Function
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim arrFolders As Variant, _
varFolder As Variant, _
olkFolder As Outlook.MAPIFolder
On Error GoTo ehOpenOutlookFolder
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
Do While Left(strFolderPath, 1) = "\"
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
Loop
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
If IsNothing(olkFolder) Then
Set olkFolder = Session.Folders(varFolder)
Else
Set olkFolder = olkFolder.Folders(varFolder)
End If
Next
Set OpenOutlookFolder = olkFolder
End If
On Error GoTo 0
Exit Function
ehOpenOutlookFolder:
Set OpenOutlookFolder = Nothing
On Error GoTo 0
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
..
Report items don't have a FlagStatus property, so we can't use the same condition to move them. Do you have another condition you want to apply, or should the code jsut flatly move them to the archive?
ASKER