Is it possible

[korgul]

First a little background

I take care of a mailbox here at work that receives notifications from our antivirus program when it finds a virus on a computer. All of the E-mails that are received into the mailbox have the same subject line. Now, we might receive 10 or more from one machine. The only way that I can see which machine is infected is if I open the E-mail. Opening 10, 20 or even 30 is not so bad. Opening over 800 in a day takes some time. What I want to do is have a script that will automaticaly save the E-mails as a text file to the C drive. Then go through the body of the newly created txt file and pull the machine name out of the E-mail, then save the E-mail as machinename.txt. After it is done renaming the txt files I want to delete any that might be duplicates.

Is this possible?

korgul

[-FMA]

Its probably possible, I don't know how but thats a great idea!

[meese]

Maybe one of these can help you:

http://www.convertzone.com/net/cz-ab...er-eml-msg.htm
http://www.di-mgt.com.au/dbxanalyzer/
http://www.outlookextract.com/

[vass0922]

Heya Korgul, long time no see!

Korgul, a few ways you can do it
is this with ms exchange?
Do you have public folders?
You can put an events script on a public folder that when it receives a message will run a specified script.

Otherwise, its fairly easy to write a script that attaches to outlook, and gets a collection of the messages to parse through them.

Here's a sample script I whipped up real quick

Const olFolderInbox = 6

Set oOutlook = CreateObject("Outlook.Application")
Set olns = oOutlook.Application.GetNameSpace("MAPI")
' Set MyFolder to the default contacts folder.
Set oInbox = olns.GetDefaultFolder(olFolderInbox)
' Set MyItem to the collection of items in the folder.
Set oAllMail = oInbox.Items
For Each oMail in oAllMail
wscript.echo oMail.Body
Next

Now with oMail.Body you can put that into a text file using FSO

SO without further ado... <drum roll>

you can do something cheesy like this!

Const olFolderInbox = 6

Set oOutlook = CreateObject("Outlook.Application")
Set olns = oOutlook.Application.GetNameSpace("MAPI")
' Set MyFolder to the default contacts folder.
Set oInbox = olns.GetDefaultFolder(olFolderInbox)
Set objFSO = CreateObject("Scripting.FileSystemObject")
' Set MyItem to the collection of items in the folder.
Set oAllMail = oInbox.Items
For Each oMail in oAllMail
  wscript.echo oMail.Body
  Set objFile = objFSO.CreateTextFile("C:\Temp\" & oMail.Subject, True)
  objFile.Write oMail.Body
  objFile.Close

Next

This will at the very least get you started
Sorry didn't see this last week :/

[korgul]

Cool
Thanks Vass I will see what I can do. Thanks for the help.

Yes it has been awhile since I was here last. Been really busy lately.

[korgul]

Ok got it working with a macro in outlook.

Option Explicit
Const sSearch As String = "Computer: "
Const sBase   As String = "c:\Virus-Related\"
Sub SaveEmailToText()
    Dim oNameSpace      As Outlook.NameSpace, oTargetFolder  As Outlook.MAPIFolder
    Dim oMailToProces   As Outlook.Items, oMail              As Outlook.MailItem
    Dim sDate           As String, sPath As String, sName As String

    On Error GoTo UnExpected
    Set oNameSpace = Application.GetNamespace("MAPI")
    Set oTargetFolder = oNameSpace.PickFolder
    If TypeName(oTargetFolder) <> "Nothing" Then
        Set oMailToProces = oTargetFolder.Items
         
        If TypeName(oMailToProces) <> "Nothing" Then
            For Each oMail In oMailToProces
                If (oMail.Class = olMail) Then
                    sDate = Format$(oMail.ReceivedTime, "m-dd")
                    If fExists(sBase) = False Then MkDir Path:=sBase
                    sPath = LCase(sBase & sDate)
                     
                    If fExists(sPath) = False Then MkDir Path:=sPath
                    sName = SearchComputer(oMail.Body)
                    sPath = LCase(sPath & "\" & sName & ".txt")
                     
                    oMail.SaveAs Path:=sPath, Type:=olTXT
                End If
            Next
        End If
        MsgBox "Done!"
    End If
     
     End

UnExpectedEx:
    Set oTargetFolder = Nothing
    Set oNameSpace = Nothing
    Exit Sub
     
UnExpected:
    MsgBox Err.Number & " " & Err.Description
    Resume UnExpectedEx
End Sub
Private Function SearchComputer(sBody As String) As String
    Dim iSearch     As Integer
    Dim iName       As Integer
    Dim sComputer   As String
     
    iSearch = InStr(1, sBody, sSearch, vbTextCompare)
    iSearch = (iSearch + Len(sSearch))
     
    If iSearch = 0 Then
        SearchComputer = "NOT FOUND"
        Exit Function
    Else
        iName = InStr(iSearch, sBody, Chr$(13), vbTextCompare)
        sComputer = Mid(sBody, iSearch, (iName - iSearch))
         
        SearchComputer = Trim(sComputer)
    End If
End Function
Public Function fExists(ByVal sFile As String) As Boolean
    If Right$(sFile, 1) <> "\" Then sFile = sFile & "\"
     
    If Dir(sFile, vbDirectory) <> "" Then
        fExists = True
    Else
        fExists = False
    End If
End Function

Wanted to let you all know.