VBScript to extract emails save as .msg & attachments
Hi,
Please Help me, I need a VBScript to run on a system to extract emails, rename them and save them in a folder, also if possible save their attachments in the same format, I have:
Sub SaveMsg()
Dim msg As MailItem
Const strPath As String = "C:\Documents and Settings\Transfer\"
If Inspectors.Count > 0 Then
Set msg = ActiveInspector.currentItem
Else
Set msg = ActiveExplorer.Selection(1)
End If
Dim strFileName As String, intCounter As Integer
strFileName = Trim(Replace(msg.subject, ":", ";"))
strFileName = Replace(strFileName, "<", "(")
strFileName = Replace(strFileName, ">", ")")
strFileName = Replace(strFileName, """", "'")
For intCounter = 1 To Len(strFileName)
If InStr(1, "/|*?", Mid(strFileName, intCounter, 1)) > 0 Then
Mid(strFileName, intCounter, 1) = "-"
End If
Next
strFileName = Format(msg.SentOn, "yyyymmdd-") & msg.SenderName & "-" & strFileName & Format(msg.SentOn, "-Pers") & ".msg"
msg.SaveAs Path:=strPath & strFileName, Type:=olMSG
Set msg = Nothing
End Sub
Which works fine on one system, but the other system I can't run MACROs on outlook so NEED VBScript, I have:
CONST SAVE_LOCATION = "c:\Documents and Settings\Desktop\"
dim objOutlookApp : set objOutlookApp = CreateObject("Outlook.Application")
wscript.echo objOutlookApp.Explorers.Count
if objOutlookApp.Explorers.count then
dim objExplorer : set objExplorer = objOutlookApp.Explorers.Item(1)
end if
if objExplorer.CurrentFolder = "Inbox" then
wscript.echo "Inbox found"
dim objSelection : set objSelection = objExplorer.Selection
dim objMailItem : set objMailItem = objSelection.item(1)
dim strMsgSubject : strMsgSubject = objMailItem.Subject
dim strNewFileName : strNewFileName = CorrectNamingConvention(strMsgSubject)
objMailItem.SaveAs SAVE_LOCATION & strNewFileName & ".msg"
end if
Function CorrectNamingConvention(argSubject)
'Write code here to check strMsgSubject for correct naming convention
'if it is fine, just pass argSubject as the return value as below, else change it and
'pass the new name as the return value.
CorrectNamingConvention = argSubject
End function
Which is okay, but will only do the "inbox" (I have several sub folders) and returns an error if the email is a RE: ... or FW:...
Like I say above it has to be VBScript and ideally save emails as:
{DATE} - {Sender} - {Email Title} - {Security Marker}
Also can the security marker be a select type of affair? like select - Personal (Pers), Not for release (NFR) etc.
Anyway, any help would be greatly appreciated.
Rob
Answers (0)
Be the first to answer this question