Consulting

Results 1 to 3 of 3

Thread: Save attachment only in filename contains words transfer OR cheque

  1. #1
    VBAX Newbie
    Joined
    Aug 2020
    Posts
    2
    Location

    Talking Save attachment only in filename contains words transfer OR cheque

    Hello! I have shamelessly used this coding which another user posted in the forum which extracts .doc attachments from an email and saves in a folder. I have a slightly different need for it. This looks for a specific word in the filename and saves it. I would like it to look for two words, transfer or cheque

    The code only saves if the attachment contains the word transfer. Is there any want to have it that it saves if the attachment contains the work transfer OR cheque ?

    Thank you

    Sub saveAttachtoDisk(itm As Outlook.MailItem)Dim objAtt As Outlook.AttachmentDim 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 = "C:\document folder\"
        For Each objAtt In itm.Attachments
            If LCase(objAtt.FileName) Like "*transfer*.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
    Change
    If LCase(objAtt.fileName) Like "*transfer*.doc" Then
    to
    If LCase(objAtt.fileName) Like "*transfer*.doc" Or LCase(objAtt.fileName) Like "*cheque*.doc" Then
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Newbie
    Joined
    Aug 2020
    Posts
    2
    Location
    Quote Originally Posted by gmayor View Post
    Change
    If LCase(objAtt.fileName) Like "*transfer*.doc" Then
    to
    If LCase(objAtt.fileName) Like "*transfer*.doc" Or LCase(objAtt.fileName) Like "*cheque*.doc" Then
    Brilliant. Thank you for your quick reply

Posting Permissions

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