Good afternoon all.

After 20 years since I didn't wrote a single line of code I have
started to write some VB code for Outlook.

Installed on 10 Pc without any problem (both Windows 2000 and Windows
XP with Office 2003 Sp2, Outlook build 11.6568.6568), on a single
Windows XP client the code returns all those error messages all
together:

Error description: Outlook cannot do this action on this type of
attachment.
(error description is the same for all the error numbers)

Error numbers displayed are the following:
-71286779
-1940897787
-1629470715
-1318043643
-1040171003
-763346939
-417316859
-105889787
-1975500795
-1871691771
-1767882747
-1664073723
-1560264699
-1456455675
-1352646651
-1248837627

I tried to google around and the only information that may be somehow
related to this problem are the following.
http://support.microsoft.com/kb/824393
http://support.microsoft.com/kb/818588
http://support.microsoft.com/kb/235031

Of course none of them seems like to apply to my problem.

Does anyone had a similar problem or (better) a solution for that?

Of course also any suggestion on how to enhance the code will be very
appreciated.

P.S.
I apologise for my poor english and my not elegant code.

Here you can find the code.
*********************************

Sub GetEmailAttachment(MyMail As MailItem)

'Calling error handler
On Error GoTo GetAttachments_err

'This is the path were files will be saved
Const CONST_filepath As String = "c:\Email Attachments\"

Dim objNameSpace As NameSpace
Dim objDestNameSpaces As NameSpace
Dim objInbox As MAPIFolder
Dim objDestFolder As MAPIFolder
Dim objItem As Object
Dim objAttach As Attachment
Dim Subject As String
Dim SbjText As String
Dim Filename As String
Dim strTimeStamp As String
Dim strSender As String
Dim strSubject As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult

Set objNameSpace = GetNamespace("MAPI")
Set objDestNameSpace = GetNamespace("MAPI")
Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox) 'Set the
Inbox folder
Set objDestFolder =
objDestNameSpace.Folders("images_archive").Folders ("Images_Archive")
'Set the subfolder in the archive
i = 0

'If there are unread messages (only e-mail, not calendar,
'appointments, etc..) in the Inbox folder
'the macro will proceed to examine each for attachments
'and will save them in a fixed path (declared in the constant)
'The SaveAsFile method used to save an attachment
'will overwrite an existing file of the same name without warning.
'in order to avoid any data overwrite the macro will append
'sender's name, the subject of the message and message's time stamp
'(dd.mm.yyyy_hh.nn.ss) before the file name,
'then it will flag *.tif and *.tiff files with a Blue flag,
'*.jpg and *.jpeg files with a Green flag.
'and *.pdf files with a Red flag.
'once finished all those operations messages will be moved
'in the subfolder of the *.pst file (see line 103).
For Each objItem In objInbox.Items
If objItem.Class = olMail And objItem.UnRead = True Then
For Each objAttach In objItem.Attachments
If Right(objAttach.Filename, 4) = ".tif" Then
strSubject = GetValidFileName(objItem.Subject)
strSender = GetValidFileName(objItem.SenderName)
strTimeStamp = Format(objItem.ReceivedTime, "dd.mm.yy-
hh.nn.ss")
Filename = CONST_filepath & strSender & " - " &
strSubject & " - " & strTimeStamp & " - " & objAttach.Filename
objAttach.SaveAsFile Filename
i = i + 1
objItem.FlagIcon = OlFlagIcon.olGreenFlagIcon
objItem.Save
End If
If Right(objAttach.Filename, 4) = "tiff" Then
strSubject = GetValidFileName(objItem.Subject)
strSender = GetValidFileName(objItem.SenderName)
strTimeStamp = Format(objItem.ReceivedTime, "dd.mm.yy-
hh.nn.ss")
Filename = CONST_filepath & strSender & " - " &
strSubject & " - " & strTimeStamp & " - " & objAttach.Filename
objAttach.SaveAsFile Filename
i = i + 1
objItem.FlagIcon = OlFlagIcon.olGreenFlagIcon
objItem.Save
End If
If Right(objAttach.Filename, 4) = ".jpg" Then
strSubject = GetValidFileName(objItem.Subject)
strSender = GetValidFileName(objItem.SenderName)
strTimeStamp = Format(objItem.ReceivedTime, "dd.mm.yy-
hh.nn.ss")
Filename = CONST_filepath & strSender & " - " &
strSubject & " - " & strTimeStamp & " - " & objAttach.Filename
objAttach.SaveAsFile Filename
i = i + 1
objItem.FlagIcon = OlFlagIcon.olBlueFlagIcon
objItem.Save
End If
If Right(objAttach.Filename, 4) = "jpeg" Then
strSubject = GetValidFileName(objItem.Subject)
strSender = GetValidFileName(objItem.SenderName)
strTimeStamp = Format(objItem.ReceivedTime, "dd.mm.yy-
hh.nn.ss")
Filename = CONST_filepath & strSender & " - " &
strSubject & " - " & strTimeStamp & " - " & objAttach.Filename
objAttach.SaveAsFile Filename
i = i + 1
objItem.FlagIcon = OlFlagIcon.olBlueFlagIcon
objItem.Save
End If
If Right(objAttach.Filename, 4) = ".pdf" Then
strSubject = GetValidFileName(objItem.Subject)
strSender = GetValidFileName(objItem.SenderName)
strTimeStamp = Format(objItem.ReceivedTime, "dd.mm.yy-
hh.nn.ss")
Filename = CONST_filepath & strSender & " - " &
strSubject & " - " & strTimeStamp & " - " & objAttach.Filename
objAttach.SaveAsFile Filename
i = i + 1
objItem.FlagIcon = OlFlagIcon.olRedFlagIcon
objItem.Save
End If
Next objAttach
'Moving the flagged messages to the Archive (*.pst file)
If objItem.FlagStatus = olFlagMarked Then
objItem.Move objDestFolder
End If
End If
Next

'Display a summary message
If i 0 Then
varResponse = MsgBox("I found " & i & " attached files." _
& vbCrLf & "The original messages containing an image " _
& vbCrLf & "has been moved into Images Archive" _
& vbCrLf & "and a copy of the attachment has been saved " _
& vbCrLf & "into the " & CONST_filepath & " folder" _
& vbCrLf & "from where you can open it in the usual manner " _
& vbCrLf & vbCrLf & "Would you like to view it now?" _
, vbQuestion + vbYesNo + vbDefaultButton2, "Finished!")
If varResponse = vbYes Then
Shell "Explorer.exe /e," & CONST_filepath, vbNormalFocus
End If
End If

'Clear the memory
GetAttachments_exit:
Set objNameSpace = Nothing
Set objDestNameSpace = Nothing
Set objInbox = Nothing
Set objDestFolder = Nothing
Set objItem = Nothing
Set objAttach = Nothing
Exit Sub

Error handler
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please contact Technical Support." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit

End Sub

'This function cleans the text extracted by the Subject and SenderName
fields
'from all those characters not allowed for a file name.

Function GetValidFileName(InputString) As String
GetValidFileName = Replace(InputString, ":", " ")
GetValidFileName = Replace(GetValidFileName, "/", " ")
GetValidFileName = Replace(GetValidFileName, "\", " ")
GetValidFileName = Replace(GetValidFileName, "*", " ")
GetValidFileName = Replace(GetValidFileName, "?", " ")
GetValidFileName = Replace(GetValidFileName, "", " ")
GetValidFileName = Replace(GetValidFileName, "", " ")
GetValidFileName = Replace(GetValidFileName, "|", " ")
GetValidFileName = Replace(GetValidFileName, """", " ")
End Function