Downloading Attachment from outlook by using VBA in excel based on time of sent

Brass Contributor

Hi 

 

I have the below vba code for "downloading mail attachment based on sender name".

Some time the sender will send multiple files in a day itslelf, but I want to download first file he sent to me using the vba. (Based on time of Sending) 

What changes to be done in the code in this case. 

 

Sub DATA()
Dim ol As Object 'Outlook.Application
Dim ns As Object 'Outlook.Namespace
Dim fol As Object 'Outlook.Folder
Dim i As Object
Dim mi As Object 'Outlook.MailItem
Dim at As Object 'Outlook.Attachment
Dim fso As Object 'Scripting.FileSystemObject
Dim dir As Object 'Scripting.Folder
Dim dirName As String
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim f As Integer
' change 1
Dim inboxFol As Object 'Outlook.Folder
Dim subFol As Object 'Outlook.Folder

'Some Set Ups
Set fso = CreateObject(Class:="Scripting.FileSystemObject")
Set ol = CreateObject(Class:="Outlook.Application")
Set ns = ol.GetNamespace("MAPI")
' change 2
Set inboxFol = ns.GetDefaultFolder(6) 'olFolderInbox
Set subFol = inboxFol.Folders("Operation")

'Finding the search item from Oulook Inbox
For Each i In inboxFol.Items
If i.Class = 43 Then
Set mi = i
If mi.Attachments.Count > 0 And InStr(mi.SenderName, "Ahmed") Then
dirName = "C:\Work Area"
If fso.FolderExists(dirName) Then
Set dir = fso.GetFolder(dirName)
Else
Set dir = fso.Createfolder(dirName)
End If


'Saving Attachment to a folder
For Each at In mi.Attachments
If Right(at.Filename, 4) = "xlsm" Then
at.SaveAsFile dir.Path & "\" & "Daily Work Data.xlsm"

End If
Next at
' change 4
mi.UnRead = False
mi.Move subFol
End If
End If
Next i

'Setting Folder
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("C:\Work Area")


CreateObject("shell.application").Open ("C:\Work Area\Daily Work data.xlsm")

 


End Sub

 

0 Replies