Private Sub Items_ItemAdd(ByVal Item As Object)
Dim colAtts As Outlook.Attachments
Dim oAtt As Outlook.Attachment
Dim sFile As String
Dim sDirectory As String
Dim sFileType As String
Dim Cats() As String
Dim i&
Dim Exists As Boolean
Set colAtts = oMail.Attachments
If colAtts.Count Then
For Each oAtt In colAtts
sFileType = LCase$(Right$(oAtt.Filename, 4))
Select Case sFileType
Case ".xml"
sFile = ATTACHMENT_DIRECTORY & oAtt.Filename
oAtt.SaveAsFile sFile
If Len(Item.Categories) Then
Cats = Split(Item.Categories, ";")
For i = 0 To UBound(Cats)
If LCase$(Cats(i)) = LCase$(AUTO_CATEGORY) Then
Exists = True
End If
Exit For
Next i
End If
If Exists = False Then
Item.Categories = Item.Categories & ";" & AUTO_CATEGORY
Item.Save
Else
Item.Categories = AUTO_CATEGORY
Item.Save
End If
Case Else
End Select
Next oAtt
End If
End Sub