Outlook 2002 Attachments

[choccylad]

Hi,

Does anyone know if it is possable to detach attachments from multiple emails. We used to use Lotus Notes and one of our users used to do this. Now we have migrated to Outlook he seems to be stuck. The problem is he receives loads of timesheets with attachments and needs to save these easily.

Any help would be appreciated.

Regards
Ori.

 

[bonifale]

Ori,

Take a look at...

http://www.experts-exchange.com/Applications/MS_Office/Outlook/Q_20743438.html

Hope this helps.

 

[choccylad]

hmm, Very interesting thread but the Macro does not work just produces a error code. Does anyone know how to get this working or is their a share prog to do this ?

 

[bonifale]

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&quot
Set oFolder = oNS.GetDefaultFolder(olFolderInbox)
Set myFolder = oFolder.Folders("Timesheets&quot
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