1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
| On Error Resume Next
Dim olkApp, olkMessage, objFSO, objFile, varFile, varNewFileName
Set olkApp = GetObject(,"Outlook.Application")
If TypeName(olkApp) <> "Application" Then
Set olkApp = CreateObject("Outlook.Application")
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each varFile In WScript.Arguments
Set olkMessage = olkApp.CreateItemFromTemplate(varFile)
varNewFileName = ReplaceIllegalCharacters( Year(olkmessage.ReceivedTime) & " " & olkMessage.SenderName & " " & olkMessage.Subject) & ".msg"
Set objFile = objFSO.GetFile(varFile)
objFile.Name = varNewFileName
Next
Set objFile = Nothing
Set objFSO = Nothing
Set olkMessage = Nothing
Set olkApp = Nothing
WScript.Quit
Function ReplaceIllegalCharacters(strSubject)
Dim strBuffer
strBuffer = Replace(strSubject, ":", "")
strBuffer = Replace(strBuffer, "\", "")
strBuffer = Replace(strBuffer, "/", "")
strBuffer = Replace(strBuffer, "?", "")
strBuffer = Replace(strBuffer, Chr(34), "'")
strBuffer = Replace(strBuffer, "|", "")
strBuffer = Replace(strBuffer, "*", "-")
strBuffer = Replace(strBuffer, "<", "-")
strBuffer = Replace(strBuffer, ">", "-")
strBuffer = Replace(strBuffer, ",", "_")
strBuffer = Replace(strBuffer, ".", "_")
strBuffer = Replace(strBuffer, "&", "-")
strBuffer = Replace(strBuffer, "(", "_")
strBuffer = Replace(strBuffer, ")", "_")
strBuffer = Replace(strBuffer, "^", "_")
strBuffer = Replace(strBuffer, "#", "_")
strBuffer = Replace(strBuffer, "@", "_")
strBuffer = Replace(strBuffer, "!", "_")
strBuffer = Replace(strBuffer, "~", "_")
strBuffer = Replace(strBuffer, "'", "")
ReplaceIllegalCharacters = strBuffer
End Function |
