[imported_Jack]

I hate to see a forum with no posts so I thought I would post an example of how to change the messageclass of an outlook item.

Use this at your own risk - Changing message classes in Outlook can cause unpredictable results.

Create a form (frmMessageClass) with a command button (cmdProcess), Current Class Label (lblCurrent), status label (lblStatus), text box for new class type (txtNew), label for the default message class of the folder (lblDefault).

**CODE **

Option Explicit
Private ol As Object
Private olns As Object
Private olFolder As Object
Private AllItems As Object
Private Itm As Object
Private NumItems As Integer
Private ItemID As Integer
Private CurFolder As String

Private Sub cmdProcess_Click()
Dim I As Integer
I = 0
If NumItems <> 0 And txtNew <> "" And Right(txtNew, 1) <> "." Then
For Each Itm In AllItems
I = I + 1
'If InStr(1, UCase(Itm.MessageClass), "IPM.CONTACT") <> 0 Then
lblCurrent = Itm.MessageClass
lblStatus = "Updating " & I & " of " & NumItems & "..."
frmMessageClass.Repaint
If Itm.MessageClass <> txtNew Then
Itm.MessageClass = txtNew
Itm.Save
End If
'End If
Next
lblStatus = "Finished processing message classes."
Else
MsgBox "Cannot process request." & Chr(13) & "Either there are no items of this type or the Message Class is missing or ends in a period.", 0, "Change Message Class"
End If
End Sub


Private Sub UserForm_Initialize()
On Error GoTo ErrorHandler
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set olFolder = ol.ActiveExplorer.CurrentFolder
CurFolder = olFolder ' get the name of the folder

GoTo Jump
ErrorHandler:
MsgBox "Make sure Outlook is running before running this utility. If Outlook is running, try restarting Outlook and/or your system. If this does not resolve the problem, please reinstall Outlook to re-register the application."
End
Jump:
End Sub


Sub UpdateFolderInfo()
lblDefault = olFolder.DefaultMessageClass
lblCurrent = ""
txtNew = lblDefault
Set AllItems = olFolder.Items
NumItems = AllItems.Count
lblStatus = "Total no. of items:" & Str(NumItems)
End Sub