callyb
08-17-2020, 06:30 AM
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
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