Solved: save e-mails to local disk

[korgul]

Greetings, I am new to VB and was wondering if there is a way to save E-mails from a folder in my PST file to the local C drive.

background on why I need to do this.

I am a member of the helpdesk and take care of the virus E-mails. We receive these E-mails from Norton anti virus into a public (helpdesk) mapi mailbox. I then move the E-mails from that into their own pst file. I then go through the E-mails and pull out the machine name and save them to my local hard drive as the machine name. What I want to do is automate this. I need to save the E-mails as a txt file to the local C drive with the machine name into a folder that is created by the program. The folder should be named by the date that the E-mail was received.
I am running outlook 2000 sr1.

Is it possible to do this?

[MOS MASTER]

Hi and Welcome to VBAX!

That's quite a lot of questions wrapped into a few lines!

Would you be so kind to provide the steps you want coded out? (It's kinda late now but I'll probably code it for you tommorow)

Like:

1. Loop through all mails in folder x
2. Check received date
3. If folder with that date exists then
4. Save mail in that folder as *.txt
5. If not make folder (Wat is the base root for all those date folders?)
6. Etc..what you're missing

Enjoy!

[korgul]

Ok I will see if I can write this out.

The E-mails are stored in there own pst file called virus.pst. they are in a folder called virus in that same pst file.

What I am trying to do.
read the 2nd line of the body of the E-mail to get machine name.
check for and create if not preset a folder named c:\virus-related\"folder name" folder name = date E-mail received.
save files to a folder as c:\virus-related\"folder name" \machinename.txt

sorry for the confusion.
Thanks

[MOS MASTER]

Hi,

Just for me to make shure I'll do allright tommorow.

Read the second line of the body for the machine name. Are you shure that's everything on that line? (No spaces or other caracters? Or is it between " ")

Then about your separate *pst story.

Is that *pst file loaded at the time of execution? In other words can you browse to that folder and open and read the files?

That's kinda important..

Talk to yah tommorow!

[korgul]

Here is a copy of the body of the E-mailAlert: Virus Found

Computer: REBECCAS

Date: 05/23/2005

Time: 11:59:16 PM

Severity: Critical

Source: Symantec AntiVirus Corporate Edition

Virus Name: Trojan.Tooso.F

User: SYSTEM

File Path: Verses.rar

There are no spaces between the lines.
The pst file is loaded and I can browse the folders at the time of execution.

[MOS MASTER]

Ok..got enough info.

We can make this work!

[korgul]

Cool,

Thanks for taking a look at this for me so quick.

[MOS MASTER]

Cool,

Thanks for taking a look at this for me so quick.

Hi,

You're welcome...just returned from work and wil answer some question first and then code your stuff A.S.A.P.!

[MOS MASTER]

Ok made the time for you!

Paste this in a new codemodul Save the project and Run "SaveEmailToText" with ALT+F8

[VBA]
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, "Short Date")
sPath = sBase & sDate

If fExists(sPath) = False Then MkDir Path:=sPath
sName = SearchComputer(oMail.Body)
sPath = sPath & "\" & sName & ".txt"

oMail.SaveAs Path:=sPath, Type:=olTXT
End If
Next
End If
MsgBox "Done!"
End If

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
[/VBA]

One Cave-at though!
I have made and tested this code in Outlook 2003! So it's possible I've used something that isn't available in Outlook 2000!

If you receive some kind of error please post back and I'll test the code on a 2000 machine to test the code in a 2k enviroment.

Enjoy!

[korgul]

Paste this in a new codemodul Save the project and Run "SaveEmailToText" with ALT+F8

Ok what I have done is copy and paste the code into VB editor in outlook save the project and then from there hit the run button.
I get the

76 path not found. error

[MOS MASTER]

Hi,

That's not so bad!!

The code presumes that you have a base folder called:
c:\virus-related\

Do you have this one on your testmachine?

[MOS MASTER]

I Run a little text with the folder virus-related deleted and I receive the exact error.

So does my comment end the problem?

[korgul]

Yep that is already created.

[MOS MASTER]

Can you comment out the On error goTo Unexpected line. Put a ' in front of it.

Run the code an go to the error and tell me what line it is?

I think it will be the MkDir part if so move your cursor over sPath and check to see what part of that path is not correct on your machine.

[MOS MASTER]

Hi,

I've improved the code so it wil create the basefolder aswell! (Provided you have a C drive)

[VBA]
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, "Short Date")
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

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[/VBA]

Please try and give feedback!

[korgul]

K,
I copied and pasted the most recent code over the old code and still get the same error.

I looked for the line you want me to comment out but could not find it.

Thanks again for your help on this. I went through over 1200 E-mails this morning that were in the virus.pst file.

Not sure if it matters or not but the location of the folder in the E-mail is called virus and it is in its own virus.pst file.

[korgul]

sorry found the line you were talking about.


with it commented out I get a run-time error 76

[MOS MASTER]

Hi,

At the end of the this code:[VBA]
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
[/VBA]

Put a ' in front of On Error GoTo Unexpected.

Run the code again on error don't click abort but errorfinding. (or however its called in english)

I'll try the code later on a 2000 machine to find out for myself what the problem is.

Could be something wrong with getting the machinename from the body of the email...

So try it and tell me on which command the VBE stopped runtime.

[MOS MASTER]

sorry found the line you were talking about.


with it commented out I get a run-time error 76

Yes I understand but you have to buttons on that message one is to abort the other one to goto the error.

Tell me which line is colloured yellow by the Editor?

[MOS MASTER]

Ok hold on this Over seas code debugging can take a while! (But I'll test on 2000 soon)

Try something else to:

In the Editor goto menu Errorhandeling (Or something called error) Press Compile project 1

Do you get a syntax error?