Outlook amend VBA to overwrite if file exists in destination folder

[leemcder]

Hi, I've used this macro code written by Graham Mayor to save attachments which arrive in to my outlook inbox and save them with the email subject. Is it possible so it can overwrite any documents in the destination folder which has the same file name? Many thanks

Sub Test()Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    Save_As_Subject olMsg
lbl_Exit:
    Exit Sub
End Sub


Sub Save_As_Subject(olItem As MailItem)
'Graham Mayor - http://www.gmayor.com - Last updated - 13 Jan 2018
Dim olAttach As Attachment
Dim strFileName As String
Dim strExt As String
Const strPath = "Y:\accounts\Conv slips\"    'the path to store the files


    For Each olAttach In olItem.Attachments
        strExt = Mid(olAttach.FileName, InStrRev(olAttach.FileName, Chr(46)))
        Select Case LCase(strExt)
            Case Is = ".docx", ".dotx", ".pdf", ".xlsx", ".zip", ".html", ".jpeg", ".txt", "xls", ".htm", ".doc"  'the wanted extensions
                strFileName = olItem.Subject
                strFileName = CleanFileName(strFileName)
                strFileName = strPath & strFileName & strExt
                olAttach.SaveAsFile strFileName
            Case Else
        End Select
    Next olAttach
lbl_Exit:
    Set olItem = Nothing
    Set olAttach = Nothing
    Exit Sub
End Sub


Private Function CleanFileName(strFileName As String) As String
     'Graham Mayor - http://www.gmayor.com - Last updated - 05 Jul 2017
     'A function to ensure there are no illegal filename
     'characters in a string to be used as a filename
    Dim arrInvalid() As String
    Dim vfName As Variant
    Dim lng_Name As Long
    Dim lng_Ext As Long
    Dim lngIndex As Long
    CleanFileName = strFileName
     '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
     '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

 

[rollis13]

This new line of code should do:

'...
strFileName = strPath & strFileName & strExt
If (Dir$(strFileName) <> "") Then Kill strFileName '<- added (delete file if already exists)
olAttach.SaveAsFile strFileName
'...

By the way, what if you have more than one attachment in the email ? have you considered the case ?

 

[leemcder]

This new line of code should do:

'...
strFileName = strPath & strFileName & strExt
If (Dir$(strFileName) <> "") Then Kill strFileName '<- added (delete file if already exists)
olAttach.SaveAsFile strFileName
'...

Thank you, its much appreciated.