Consulting

Results 1 to 15 of 15

Thread: Excluding Specific Words?

  1. #1

    Excluding Specific Words?

    Gmayor,
    I'm back at it. Using the rule/code we (you) created on a different thread for a different issue, but listed below, what would I add/modify to EXCLUDE any .pdf with "Packing Slip" anywhere in the name?

    [vba]
    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
    For Each Atmt In Item.Attachments
    myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
    Select Case myExt
    Case ".pdf"
    FileName = "...\AP Invoices for Processing" & _
    Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
    Atmt.SaveAsFile FileName
    Case Else
    End Select
    Next Atmt
    End Sub
    [/vba]
    The best part of the work out? The End

  2. #2
    You need another check for the filename
    Use the # button to insert the CODE tags

    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
        For Each Atmt In Item.Attachments
            myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
            Select Case myExt
                Case ".pdf"
                    If Not LCase(Atmt.FileName) Like "*packing slip*" Then
                        FileName = "...\AP Invoices for Processing" & _
                                   Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Atmt.FileName
                        Atmt.SaveAsFile FileName
                    End If
                Case Else
            End Select
        Next Atmt
    End Sub
    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
    Outstanding, and finally:
    The invoices are coming in, being pulled and labelled as such -> 20180410_135116_Invoices.pdf
    dated, time of processing, and title the sending may have had on the pdf.

    So, is there a way, in the file name creation process to also add who the invoice came from, IE: either the full email address or simply the "domain.com"?
    The best part of the work out? The End

  4. #4
    Change the code to

    If Not LCase(Atmt.fileName) Like "*packing slip*" Then
        fileName = CleanFileName(Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Item.SenderEmailAddress & "_" & Atmt.fileName, "pdf")
        fileName = "C:\Path\AP Invoices for Processing\" & fileName
        Atmt.SaveAsFile fileName
    End If
    and add the following function to check for illegal filename characters - there probably won't be any, but this will prevent it crashing if there are.

    Private 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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    Thanks,
    I understand how to replace the text with the first section in the coding, but in what relation do I add the second section? In it, above it, below it? I mean, what would the two section look like as one?
    The best part of the work out? The End

  6. #6
    The function is a separate macro called from the first one. Simply add it to the module after the End Sub line of the first one.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    Thanks, will give it a shot
    The best part of the work out? The End

  8. #8
    I'm getting a file path doesn't exist error pointing to the
    Atmt.SaveAsFile fileName
    The best part of the work out? The End

  9. #9
    scratch that, I cut your code and forgot to update the file path to the actual path, will again let you know.
    The best part of the work out? The End

  10. #10
    Now it doesn't do anything, even with the correct path in place, no errors or anything.
    HTML Code:
    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
        For Each Atmt In Item.Attachments
            myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
            Select Case myExt
                Case ".pdf", “.PDF”
                    If Not LCase(Atmt.fileName) Like "*packing slip*" Then
                              fileName = CleanFileName(Format(Item.CreationTime, "yyyymmdd_hhmmss_") & Item.SenderEmailAddress & "_" & Atmt.fileName, "pdf")
                              fileName = "C:\Path\AP Invoices for Processing\" & filename Atmt.SaveAsFile fileName
                     End If
                Case Else
            End Select
        Next Atmt
    End Sub 
    
    Private 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 lngIndexlbl_Exit:
        Exit Function
    End Function
    The best part of the work out? The End

  11. #11
    Ok, last post, and I'm done, for the day I forgot the damn "" at the end of the file path. Got that corrected and the script is now pulling in ".pdf" AND ".PDF", and also who the invoice came from, but it is pulling in TOO much info.
    IE: the files are now labelled as such:
    20180419_104034__O=MY COMPANY'S DOMAIN_OU=EXCHANGE ADMINISTRATIVE GROUP (FYD........PDLT)_CN=RECIPIENTS_CN=NAME OF SENDER1E3_Inv_8749_from_TMFL_Parts_16056.PDF

    How do I have it continue to pull, but not all of that info, more of just the "name of sender" or anything after the "@" sign of the email address, IE: emily@XYZ.com, just pull the "XYZ" or "XYZ.com" without screwing up the file format?
    The best part of the work out? The End

  12. #12
    Declare two more variables

    Dim strSender As String
    Dim strDomain As String
    then you can derive the name and domain from the e-mail address e.g.

        strSender = "": strDomain = ""
        If InStr(1, Item.SenderEmailAddress, "@") > 0 Then
            strSender = Split(Item.SenderEmailAddress, "@")(0)
            strDomain = Split(Item.SenderEmailAddress, "@")(1)
            'If you want the first part of the domain only then split again
            strDomain = Split(strDomain, Chr(46))(0)
        End If
        'MsgBox strSender & vbCr & strDomain 'for confirmation only
    Use strSender and/or strDomain as required in your filename string
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  13. #13
    can you explain the placement and last statement better? I'm a little confused by it. In that I mean:

    Private 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
    Dim strSender As String             <---------ADDED
    Dim strDomain As String             <---------ADDED
        '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 lngIndexlbl_Exit:
        Exit Function
    End Function
    
    
    I don't understand where to substitute this in or if I'm needing to just add it into the existing code.  If needed to just add in, where?
    ------------------------------------------------------------------------------------
    strSender = "": strDomain = ""
        If InStr(1, Item.SenderEmailAddress, "@") > 0 Then
            strSender = Split(Item.SenderEmailAddress, "@")(0)
            strDomain = Split(Item.SenderEmailAddress, "@")(1)
            'If you want the first part of the domain only then split again
            strDomain = Split(strDomain, Chr(46))(0)
        End If
        'MsgBox strSender & vbCr & strDomain 'for confirmation only
    Last edited by thejester; 04-20-2018 at 09:09 AM.
    The best part of the work out? The End

  14. #14
    It goes in the main macro to enable you to create your filename using the name or domain as required e.g.


    Public Sub SaveAttachmentsToDisk(Item As Outlook.MailItem)
    Dim Atmt As Attachment
    Dim FileName As String
    Dim myExt As String
    Dim strSender As String, strDomain As String
        strSender = "": strDomain = ""
        If InStr(1, Item.SenderEmailAddress, "@") > 0 Then
            strSender = Split(Item.SenderEmailAddress, "@")(0)
            strDomain = Split(Item.SenderEmailAddress, "@")(1)
            'If you want the first part of the domain only then split again
            strDomain = Split(strDomain, Chr(46))(0)
        End If
        For Each Atmt In Item.Attachments
            myExt = Mid(Atmt.FileName, InStrRev(Atmt.FileName, Chr(46)))
            Select Case LCase(myExt)
                Case ".pdf"
                    If Not LCase(Atmt.FileName) Like "*packing slip*" Then
                        FileName = CleanFileName(Format(Item.CreationTime, "yyyymmdd_hhmmss_") & strSender & "_" & Atmt.FileName, "pdf")
                        'or
                        'FileName = CleanFileName(Format(Item.CreationTime, "yyyymmdd_hhmmss_") & strDomain & "_" & Atmt.FileName, "pdf")
                        FileName = "C:\Path\AP Invoices for Processing\" & FileName
                        Atmt.SaveAsFile FileName
                    End If
                Case Else
            End Select
        Next Atmt
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  15. #15
    Seems to have done the trick.
    Bir demet teşekkürler, sen erkeksin
    or

    Χάρη σε μια δέσμη, είσαι ο άνθρωπος
    The best part of the work out? The End

Posting Permissions

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