Consulting

Results 1 to 3 of 3

Thread: Save attachment only in filename contains a specific word

  1. #1
    VBAX Regular
    Joined
    Feb 2018
    Posts
    70
    Location

    Save attachment only in filename contains a specific word

    I've started using this code which saves .doc attachments which hit my outlook mailbox. Is it possible to only save the attachment if the file names contains the word "client" ?

    any help with this is much appreciated.

    Many thanks
    Sub saveAttachtoDisk(itm As Outlook.MailItem)Dim objAtt As Outlook.Attachment
    Dim saveFolder As String
    Dim strSubject As String
    Dim strName As String
        strSubject = "Our Ref: " & Right(itm.Subject, Len(itm.Subject) - InStrRev(itm.Subject, Chr(32)))
        saveFolder = "Y:\accounts\success fee bills\"
        For Each objAtt In itm.Attachments
            If Right(LCase(objAtt.FileName), 4) = ".doc" Then
                strName = CleanFileName(strSubject & ".doc", ".doc")
                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

  2. #2
    VBAX Regular
    Joined
    Feb 2018
    Posts
    70
    Location
    I thought maybe changing line
    If Right(LCase(objAtt.FileName), 4) = ".doc" Then
    with
    If LCase(objAtt.FileName) Like "*client*.doc" Then
    This doesn't seem to work, anyone got any ideas where I've gone wrong?

  3. #3
    Assuming these are DOC format files and not DOCX/DOCM format files then try
    If Right(LCase(objAtt.FileName), 4) = ".doc" Then
        If InStr(1, LCase(objAtt.FileName), "client") > 0 Then
            strName = CleanFileName(strSubject & ".doc", ".doc")
            objAtt.SaveAsFile saveFolder & strName
        End If
    End If
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •