Hi,

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

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!