Hello everyone.

Let me start by saying, please be gentle, I’m not a programmer but I’m a tech. Programming is not my area of expertise.

That being said, my users were using Eudora as a mail client. Eudora has an option to automatically save mail attachments to a distant folder. In our case the attachments are saved to a network folder. We are replacing Eudora with Outlook but unfortunately Outlook does not offer this option. I found multiple scripts on the web but most was just too complicated for my needs so I managed to simplify one and make it work. Here is the script:

[VBA]
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

Dim objAtt As Outlook.Attachment

Dim saveFolder As String
saveFolder = "c:\temp\"

For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
Set objAtt = Nothing
Next
End Sub
[/VBA]
Now the issue I have is that if I receive multiple emails with attachments that have the same name, witch is often the case here, the latest attachment will overwrite the older attachment without warning. What I’m trying to do in the script bellow is to rename the attachments when they come in by adding a decimal at the end of the file name. Unfortunately my script bellow does not work. It runs in a loop non stop and I have no clue what I’m doing thus no clue how to fix this or what is missing.

[VBA]
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)

On Error Resume Next

Dim objAtt As Outlook.Attachment

Dim saveFolder As String
Dim stFileName As String
Dim i As Integer

saveFolder = "c:\temp"

For Each objAtt In itm.Attachments
stFileName = saveFolder & "\" & objAtt.DisplayName
i = 0
While FileLen(stFileName) > 0
If Err <> 0 Then Err = 0
i = i + 1
stFileName = saveFolder & "\" & Str(i) & objAtt.DisplayName
MsgBox stFileName
Wend
If Err <> 0 Then Err = 0
objAtt.SaveAsFile stFileName
Set objAtt = Nothing
Next
End Sub
[/VBA]
Is there a genius out here that can help me with this? PLEASE!!!!

Thanks a bundle.
Mike