OUTLOOK VBA HELP....PLEASE

[leemcder]

Hi, I am running this script along with a rule. When an email is received from a specified person and it contains an attachment, it will run the script. The script saves a copy of the attachment and renames it as the subject. The format of the attachment received in the email is in .XLS format and I want to keep that format. The script is saving the file to my path and renaming it as the subject but I can't open the file, I get "the file format and extension of file name don't match. The file could be corrupt or unsafe"

Can anyone help me?

Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
saveFolder = "Y:\accounts\success fee bills"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "" & itm.Subject & ".XLS"
Set objAtt = Nothing
Next
End Sub

[gmayor]

The problem with your code is that it takes each attachment in the attachment collection and saves it with a filename with the extension xls. Each subsequent attachment is overwritten with the same name, so you end up with the last attachment in the collection, regardless of what it is (it could be an image in the message signature) saved as xls.

You need to ensure that you are processing the required attachment. Then there is the issue of the subject, over which you have no control and which may contain illegal filename characters which would cause an error - and finally your path does not end with a path separator character so the file is saved in the 'accounts' folder with the name prefix 'success fee bills'.

Personally I would add error checking for the prescence of both the folder and address the existence of the filename in the folder (especially important if there are two or more workbooks attached), but I will let that go as I have covered it in this forum previously.

Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim strName As String
    saveFolder = "Y:\accounts\success fee bills\"
    For Each objAtt In itm.Attachments
        If Right(LCase(objAtt.fileName), 4) = ".xls" Then
            strName = CleanFileName(itm.Subject & ".xls", ".xls")
            objAtt.SaveAsFile saveFolder & strName
        End If
    Next objAtt
    Set objAtt = Nothing
End Sub

Public Function CleanFileName(strFilename As String, strExtension As String) As String
'Graham Mayor
'A function to ensure there are no illegal filename
'characters in a string to be used as a filename
'strFilename is the filename to check
'strExtension is the extension of the file
Dim arrInvalid() As String
Dim vfName As Variant
Dim lng_Name As Long
Dim lng_Ext As Long
Dim lngIndex As Long
    'Ensure there is no period included with the extension
    strExtension = Replace(strExtension, Chr(46), "")
    'Record the length of the extension
    lng_Ext = Len(strExtension)

    'Remove the path from the filename if present
    If InStr(1, strFilename, Chr(92)) > 0 Then
        vfName = Split(strFilename, Chr(92))
        CleanFileName = vfName(UBound(vfName))
    Else
        CleanFileName = strFilename
    End If

    'Remove the extension from the filename if present
    If Right(CleanFileName, lng_Ext + 1) = "." & strExtension Then
        CleanFileName = Left(CleanFileName, InStrRev(CleanFileName, Chr(46)) - 1)
    End If

    'Define illegal characters (by ASCII CharNum)
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    'Add the extension to the filename
    CleanFileName = CleanFileName & Chr(46) & strExtension
    'Remove any illegal filename characters
    For lngIndex = 0 To UBound(arrInvalid)
        CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lngIndex)), Chr(95))
    Next lngIndex
lbl_Exit:
    Exit Function
End Function

[leemcder]

Thank you Graham, this is excellent and exactly what I wanted. Your help is much appreciated. Thank you