Dim WithEvents olkFolder As Outlook.Items
Private Sub Application_Quit()
Set olkFolder = Nothing
End Sub
Private Sub Application_Startup()
Set olkFolder = Session.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub olkFolder_ItemAdd(ByVal Item As Object)
'Edit the condition on the next line'
If InStr(1, Item.Subject, "TK:") Then
'Edit the folder path on the next line'
Item.SaveAs "\\bc04\Main\Data\Folder\" & RemoveIllegalCharacters(Item.Subject) & ".msg", olMSG
End If
End Sub
Function RemoveIllegalCharacters(strValue As String) As String
' Purpose: Remove characters that cannot be in a filename from a string.'
' Written: 4/24/2009'
' Author: BlueDevilFan'
' Outlook: All versions'
RemoveIllegalCharacters = strValue
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function
|