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]

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

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"
                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

---

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"?

Change the code to

Code:

---

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.

Code:

---

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

---

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 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.

Thanks, will give it a shot

I'm getting a file path doesn't exist error pointing to the
Atmt.SaveAsFile fileName

scratch that, I cut your code and forgot to update the file path to the actual path, will again let you know.

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

---

Ok, last post, and I'm done, for the day :bug: 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?

Declare two more variables

Code:

---

Dim strSender As String
Dim strDomain As String

---

then you can derive the name and domain from the e-mail address e.g.

Code:

---

    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

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

Code:

---

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

---

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

Code:

---

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

---

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

Χάρη σε μια δέσμη, είσαι ο άνθρωπος