Hi everyone,
I basically have a vbs script to rename all outlook messages stored as .msg files so that they actually are relevant to someone looking for a specific message. The script works well and does what it's meant to do but I would like to be able to drop whole folders onto the script icon and having the script browse through all files in that folder and do the actions instead of having to select all messages to drop them on the script. Can someone help me with that? Thanks!!
Also, the actual procedure requires me to drag and drop my messages from outlook to a folder and then to drag and drop them on the script. Has anyone ever seen a way to integrate a script into the drag and drop function so that it would do his business as I drag the messages out of outlook?
Here's my script code that works well for files that I drop onto it but does nothing with folders :
Thanks for the help!
I basically have a vbs script to rename all outlook messages stored as .msg files so that they actually are relevant to someone looking for a specific message. The script works well and does what it's meant to do but I would like to be able to drop whole folders onto the script icon and having the script browse through all files in that folder and do the actions instead of having to select all messages to drop them on the script. Can someone help me with that? Thanks!!
Also, the actual procedure requires me to drag and drop my messages from outlook to a folder and then to drag and drop them on the script. Has anyone ever seen a way to integrate a script into the drag and drop function so that it would do his business as I drag the messages out of outlook?
Here's my script code that works well for files that I drop onto it but does nothing with folders :
Code:
On Error Resume Next
Dim olkApp, olkMessage, objFSO, objFile, varFile, varNewFileName, filenamecut
Set olkApp = GetObject(,"Outlook.Application")
If TypeName(olkApp) = "Nothing" 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(olkMessage.ReceivedTime & " - " & Left(olkMessage.SenderName,20) & " - " & olkMessage.Subject) & ".msg"
Set objFile = objFSO.GetFile(varFile)
objFile.Name = varNewFileName
Call ModFileDT (objFile.ParentFolder,objFile.Name,olkMessage.ReceivedTime)
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, "+", "et")
strBuffer = Replace(strBuffer, "/", "")
strBuffer = Replace(strBuffer, "?", "")
strBuffer = Replace(strBuffer, Chr(34), "'")
strBuffer = Replace(strBuffer, "|", "")
strBuffer = Replace(strBuffer, "°", " ")
ReplaceIllegalCharacters = strBuffer
End Function
Sub ModFileDT(strDir,strFileName,DateTime)
Dim objShell, objFolder, objFile
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace(CStr(strDir))
Set objFile = objFolder.Parsename(CStr(strFileName))
objFile.ModifyDate = CStr(DateTime)
Set objShell = Nothing
Set objFolder = Nothing
Set objFile = Nothing
End Sub