Ori,
Try this.
Create a mailfolder entitled 'Timesheets' within your Inbox.
Create a folder entitled 'C:\TimeSheets'
Place all the incoming mail with timesheets attached in there. I would set up an outlook mail rule to do this automaticaly as the mail arrives. (look at Tools->mail wizard)
Paste the code below into you module and run it once all the timesheets are received. Perhaps set up a new button to put on the toolbar that runs it. Hope this works for you.
Good Luck
Les....
Sub ExtractTimesheets()
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("Timesheets"
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:\TimeSheets\" & 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
