Solved: save e-mails to local disk

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?

Hi and Welcome to VBAX! :hi:

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

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! :whistle:

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

Hi, :yes

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! :whistle:

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.

Ok..got enough info.

We can make this work! :yes

Cool,

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

Quote:

---

Originally Posted by korgul

Cool,

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

---

Hi, :yes

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

Ok made the time for you! :yes

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! :whistle:

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

Hi, :D

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? :whistle:

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

So does my comment end the problem? :yes

Yep that is already created.

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.

Hi, :yes

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! :whistle:

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.

sorry found the line you were talking about.


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

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.

:whistle:

Quote:

---

Originally Posted by korgul

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?

Ok hold on this Over seas code debugging can take a while! :rofl: (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?

Ok ran the code with it commented out and the box that come up has Ok and help in it. If I click help it opens the help dialog to syntax error.


I ran the script on the root "personal folder" and it does not give the error, as soon as I pick a folder under the root of personal is when I get the error.

Did not get a compile error.

Quote:

---

Originally Posted by korgul

Ok ran the code with it commented out and the box that come up has Ok and help in it. If I click help it opens the help dialog to syntax error.

---

Huh...Only Ok and Help?....Is you're VBA project protected in some way....

Very strange! Can't remember Outlook 2000 to well so it's possible that those buttons are the only to provided..(I'll see when I get home)

Quote:

---

I ran the script on the root "personal folder" and it does not give the error, as soon as I pick a folder under the root of personal is when I get the error.

---

So You get the folderpicker to choose a folder and it does work on some but not on others....

Again I don't understand this I've run this code under several folders including a subfolder of Inbox (in Personal folders)

Can you do the compile thing for me I've asked before?

O and what is your exact OS and Office? (2000) I presume but are you also on exchange?

I hope we fry this puppy soon! :banghead:

Ok OS = XP, E-mail = 2000, no exchange server

Yes I get the folder picker put can only run it on the personal folder. If I pick a sub folder I get the error.

Mighty strange my friend must have something to do with the loos attached *pst files I think..

But try this separate sub:[VBA]
Sub FolderName()
Dim oNameSpace As Outlook.NameSpace, oTargetFolder As Outlook.MAPIFolder

Set oNameSpace = Application.GetNamespace("MAPI")
Set oTargetFolder = oNameSpace.PickFolder

If TypeName(oTargetFolder) <> "Nothing" Then
MsgBox oTargetFolder.Name
End If

Set oTargetFolder = Nothing
Set oNameSpace = Nothing
End Sub
[/VBA]

Run it several times and check that you get the correct name of the chosen folder in the messagebox.

Enjoy! :whistle:

Ok I plugged that in. When I run it now I get the message box with the folder name that I selected.

Quote:

---

Originally Posted by korgul

Ok I plugged that in. When I run it now I get the message box with the folder name that I selected.

---

Ok that's good news at least the folder name is found by the code. So somehow something else is going wrong.

I'll have to stop for the night and try the code out when I get home.

So I'll see you tomorrow. :whistle:

Hi,

Ok did my test on a 2000 machine and all runs well!

Frustrating h?...:banghead:

This leads me to believe that the emails you're receiving might have a different layout then I acspect them to be.

The code deals with a specific format of the emails and is definitifly not foolprooff!

So I tried to add some normal emails to the folder to process and I found out I could duplicate your error if my mailreading code picked up some unwanted character in a file path.

So could you please send me some of your virus emails so I can test on those to see if the format is different then I acspect? Send to: joost@webforums.nl

For now I couldn't find anything wrong with the code so it could also be an enviroment issue on your site....(That will be hard to find)

Till tomorrow...have to sleep now! :p

On there way.

I agree it is very odd that it would work on yours but bomb out on mine. Most likely it is something that I am doing. Again, I am very new to VBA, but have some coding experience with VBScript.

Hi,

I'm sure it has nothing to do with you, so hold on...I'm in it till the end aswell! :friends:

Have received your emails and the code runs on it like a knive trough butter!

But I did notice there where special caracters in the computer names and I do wonder if maybe on of those files has a caracter in (The computername) it that is not allowed in a file path.

To find this out we need to run some debug code!

So copy this altered code in a new module and run it:[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")
Debug.Print "Date received: " & sDate

Debug.Print "Base: " & sBase
If fExists(sBase) = False Then MkDir Path:=sBase
sPath = LCase(sBase & sDate)
Debug.Print "Folder to save: " & sPath

If fExists(sPath) = False Then MkDir Path:=sPath
sName = SearchComputer(oMail.Body)
Debug.Print "Computername: " & sName

sPath = LCase(sPath & "\" & sName & ".txt")
Debug.Print "File path: " & sPath

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:
Debug.Print Err.Number & " "; Err.Description
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]

After you run it open de VBE and press CTRL+G this will open a debug window (Called "direct" in dutch)

There will be information written in it so copy all of that (IF much into a notepath) and attached it here (Enclosed in VBA tags) so I can get the info required out of there.

Enjoy! :whistle:

[VBA]Date received: 5/27/2005
Base: c:\virus-related\
Folder to save: c:\virus-related\5/27/2005
76 Path not found
[/VBA]



This is the message that I get from the de bugger.

It looks like it is trying to create the folder c:\virus-related\5/27/2005 and this is where it is bombing out.

I got it working. I changed this line in the code.


sDate = Format$(oMail.ReceivedTime, "Short Date")

to this

sDate = Format$(oMail.ReceivedTime, "m-dd")

Now when I run it, it will create the folder with todays date and then copy the mail into it.

Thanks for all of your help on this.

Quote:

---

Originally Posted by korgul

It looks like it is trying to create the folder c:\virus-related\5/27/2005 and this is where it is bombing out.

---

Hi, :yes

Great it's working now! You're most welcome! :friends:

I knew it had to be something in the environment! "Short Date" over here returns : "05-27-2005" so that's ok for a file path!

This has everything to do with regional and country settings in Control Panel. Totally overlooked this stupid mistake!

O wel good to see you noticed youreself that it's not allowed to have a: "\" or a "/" in the wrong place in a filepath!

Can I make one suggestion:
I would make this change:
sDate = Format$(oMail.ReceivedTime, "mm-dd-yyyy")

This formats as: 05-27-2005 and this if better if you're using this for a longer period than a year otherwise you run out of folders!!!!


So tell me....How much time does my macro save you each day! :yes

Enjoy! :whistle:
Ps..please don't forget to mark your thread solved!

Having the format as m-dd is not a problem as I will be deleting the folders as they get cleaned out or too old ( over a week ).

This saves a tremedous amout of time. What would take me over 2 hours to do not goes by in only secs.

This was the first part of a three part process. I now have part 1 and 2 done. Now onto part three.
The second part goes through the folders picks out the name of the file, reads 3 lines from the file and writes it to a log file. Then saves the log file as the folder name. It creates one log file for each folder.

Part three will go through the log files and pick out the file names that are duplicated and write them to another file. That way we can see which computers keep getting infected.


Thanks again for all of your help. :friends: :beerchug: :bow:

Quote:

---

Originally Posted by korgul

Having the format as m-dd is not a problem as I will be deleting the folders as they get cleaned out or too old ( over a week ).

This saves a tremedous amout of time. What would take me over 2 hours to do not goes by in only secs.
Thanks again for all of your help. :friends: :beerchug: :bow:

---

It's great to hear it saves you so much time! That's the mean reason for coding stuff and people ussualy dont believe it but when they see it they all go: Aaaaaaaaaahhhhhhhh! :yes

Well good luck on Fase II & III and I'm shure you'll gane even more time and finish you're desired Analytical tool.
(And Punish those who keep getting infected! ):devil:

Till we meet again...:whistle: