I have code that pulls all the attachments from a subfolder in my Outlook inbox and saves it to my hard drive, works great, but only seems to pull the oldest file in cases where there are duplicate file sent by the same person. Does anyone know using the following macro how to pull just the latest file from Outlook in case of duplicates, here is the code. Also if someone knows how to pull from another outlook mailbox that I have full access to (not my own), I'd appreciate that too.
Sub ExtractFiles()
Dim oApp As Application
Dim myFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.MAPIFolder
Dim oMsg As MailItem
Dim oNS As NameSpace
Dim oAttachments As Outlook.Attachments
Dim oAttachment As Object
Dim oObject As Object
Dim oSubAttachment As Object
Dim oItem As Items 'use as subattachment in this case
Dim strControl
Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
Set myFolder = oFolder.Folders("TEMP")
strControl = ""
For Each oMsg In myFolder.Items 'oMsg is an item
With oMsg 'oMsg has attachment(s)
If (oMsg.Attachments.Count > 0) Then
strControl = Day(oMsg.ReceivedTime) & Month(oMsg.ReceivedTime) & Year(oMsg.ReceivedTime)
For Each oAttachment In oMsg.Attachments
With oAttachment
oAttachment.SaveAsFile "C:\TEMP\" & strControl & "-" & oAttachment.FileName
End With
Next
Else
' The next bit looks up the sender name from the
' address book and may well fall foul of security
'
' MsgBox "No attachments on email from " & oMsg.SenderName
End If
End With
Next
End Sub
Michael
Sub ExtractFiles()
Dim oApp As Application
Dim myFolder As Outlook.MAPIFolder
Dim oFolder As Outlook.MAPIFolder
Dim oMsg As MailItem
Dim oNS As NameSpace
Dim oAttachments As Outlook.Attachments
Dim oAttachment As Object
Dim oObject As Object
Dim oSubAttachment As Object
Dim oItem As Items 'use as subattachment in this case
Dim strControl
Set oApp = New Outlook.Application
Set oNS = oApp.GetNamespace("MAPI")
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
Set myFolder = oFolder.Folders("TEMP")
strControl = ""
For Each oMsg In myFolder.Items 'oMsg is an item
With oMsg 'oMsg has attachment(s)
If (oMsg.Attachments.Count > 0) Then
strControl = Day(oMsg.ReceivedTime) & Month(oMsg.ReceivedTime) & Year(oMsg.ReceivedTime)
For Each oAttachment In oMsg.Attachments
With oAttachment
oAttachment.SaveAsFile "C:\TEMP\" & strControl & "-" & oAttachment.FileName
End With
Next
Else
' The next bit looks up the sender name from the
' address book and may well fall foul of security
'
' MsgBox "No attachments on email from " & oMsg.SenderName
End If
End With
Next
End Sub
Michael