Poundland
01-28-2016, 04:17 AM
Guys,
I have the below code, which works, it finds a specific email, and saves the attachment on the email to another folder in explorer.
The problem I have is that each day the email name will change in respect that the Date and Time will change.
How can I modify the line of code that has the name of the subject name of the email so that it looks for key words rather than the entire and full subject name?
Option Explicit
Sub SaveFundAttachments()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInBox As Outlook.MAPIFolder
Dim olMoveToFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olAtt As Outlook.Attachment
Dim strSaveToFolder As String
Dim strPathAndFilename As String
Dim Ans As Long
Dim i As Long
strSaveToFolder = "I:\H904 Supply Chain\Scott Atkinson\Dashboard\"
If Right(strSaveToFolder, 1) <> "\" Then strSaveToFolder = strSaveToFolder & "\"
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olInBox = olNS.GetDefaultFolder(olFolderInbox)
' ***** How can I amend the below line to search for part of the Subject name and not all of it *****
Set olItems = olInBox.Items.Restrict("[Subject] = 'Availability Measurement by SKU was executed at 23/01/2016 10:31:56'")
For i = olItems.Count To 1 Step -1
If olItems(i).Attachments.Count > 0 Then
For Each olAtt In olItems(i).Attachments
strPathAndFilename = strSaveToFolder & olAtt.Filename
If Len(Dir(strPathAndFilename, vbNormal)) = 0 Then
olAtt.SaveAsFile strPathAndFilename
olItems(i).Save
Else
Ans = MsgBox(olAtt.Filename & " already exists. Overwrite file?", vbQuestion + vbYesNo)
If Ans = vbYes Then
olAtt.SaveAsFile strPathAndFilename
olItems(i).Save
End If
End If
Next olAtt
End If
Next i
Set olApp = Nothing
Set olNS = Nothing
Set olInBox = Nothing
Set olMoveToFolder = Nothing
Set olItems = Nothing
Set olAtt = Nothing
End Sub
I have the below code, which works, it finds a specific email, and saves the attachment on the email to another folder in explorer.
The problem I have is that each day the email name will change in respect that the Date and Time will change.
How can I modify the line of code that has the name of the subject name of the email so that it looks for key words rather than the entire and full subject name?
Option Explicit
Sub SaveFundAttachments()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olInBox As Outlook.MAPIFolder
Dim olMoveToFolder As Outlook.MAPIFolder
Dim olItems As Outlook.Items
Dim olAtt As Outlook.Attachment
Dim strSaveToFolder As String
Dim strPathAndFilename As String
Dim Ans As Long
Dim i As Long
strSaveToFolder = "I:\H904 Supply Chain\Scott Atkinson\Dashboard\"
If Right(strSaveToFolder, 1) <> "\" Then strSaveToFolder = strSaveToFolder & "\"
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olInBox = olNS.GetDefaultFolder(olFolderInbox)
' ***** How can I amend the below line to search for part of the Subject name and not all of it *****
Set olItems = olInBox.Items.Restrict("[Subject] = 'Availability Measurement by SKU was executed at 23/01/2016 10:31:56'")
For i = olItems.Count To 1 Step -1
If olItems(i).Attachments.Count > 0 Then
For Each olAtt In olItems(i).Attachments
strPathAndFilename = strSaveToFolder & olAtt.Filename
If Len(Dir(strPathAndFilename, vbNormal)) = 0 Then
olAtt.SaveAsFile strPathAndFilename
olItems(i).Save
Else
Ans = MsgBox(olAtt.Filename & " already exists. Overwrite file?", vbQuestion + vbYesNo)
If Ans = vbYes Then
olAtt.SaveAsFile strPathAndFilename
olItems(i).Save
End If
End If
Next olAtt
End If
Next i
Set olApp = Nothing
Set olNS = Nothing
Set olInBox = Nothing
Set olMoveToFolder = Nothing
Set olItems = Nothing
Set olAtt = Nothing
End Sub