saving email attachments using VBA 1

[EliseFreedman]

Each Week, I get an MS Outlook 97 email from a colleage containing an attachment which is an excel format.

The attachment is saved with that weeks date as the filename in the format dd-mm-yy.xls. For example 13-10-03.xls etc

Is there any code I can use to detect when this attachment is received and then automatically save it as oos.xls in a specified folder to allow further processing to be done on the attachment.

I have found various addins that may do the job but the scale of the job doesnt really merit spending money on an attachment. I would prefer to use VBA. Any help would be appreciated

 

[RobBroekhuis]

The following sub (inserted into your Outlook VBAProject.otm module) does most of what you're looking for:

Private Sub Application_NewMail()
Dim fld As MAPIFolder, mi As MailItem, at As Attachment
Dim thisday As Date, MyPath As String
MyPath = "c:\"
Set fld = Application.GetNamespace("MAPI&quot.GetDefaultFolder(olFolderInbox)
Set mi = fld.Items(1)
If mi.Attachments.Count = 1 Then
Set at = mi.Attachments(1)
thisday = Date - Weekday(Date) + 2 'this give the monday of the current week
If at.FileName = Format(thisday, "dd-mm-yy&quot & ".xls" Then
at.SaveAsFile MyPath & "\oos.xls"
MsgBox "File received and saved"
End If
End If
End Sub



Rob

 

[EliseFreedman]

Great Code Rob - certainly has put me on the right lines.

However, I still have a couple of problems when I run the code. When I ran it the first time nothing happened. I then put some msgboxes into the code to try and figure out what was going on

1)Firstly for some reason the attachments count=8 even though there is only one attachment. I got around this temporarily by changing If mi.Attachments.Count = 1 to If mi.Attachments.Count = 8.
2)Even though my attachment is a spreadsheet in the form 27-10-03.xls, for some reason, Outlook seems to think that the attachment is called wmt.gif. When I changed the at.filename to wmt.gif the code worked. I opened the wmt.gif file to see what it was - it is the logo for Windows Media Technologies. If I open the attachment by opening the message manually, i can access the spreadsheet!!!

I have absolutely know idea why either of those problems are occurring. It doesnt help that I am a novice when it comes to MS Outlook programming. Any ideas would be appreciated

 

[RobBroekhuis]

Apparently some of the "attachments" are actually image files embedded in the e-mail body. This means you'll need to look through the list of attachments to find the one you need. This will slow things down a bit, but see how it works for you. Something like:

Private Sub Application_NewMail()
Dim fld As MAPIFolder, mi As MailItem, at As Attachment
Dim LookForFile As String, MyPath As String
MyPath = "c:\"
Set fld = Application.GetNamespace("MAPI&quot.GetDefaultFolder(olFolderInbox)
Set mi = fld.Items(1)
LookForFile = Format(Date - Weekday(Date) + 2, "dd-mm-yy&quot & ".xls"
For Each at In mi.Attachments
If at.FileName = LookForFile Then
at.SaveAsFile MyPath & "\oos.xls"
MsgBox "File received and saved"
End If
Next at
End Sub


Rob

 

[EliseFreedman]

Well I suppose I am a little further forward in that now I know why the attachments count=8. When I altered the code, once again nothing happened the first time. When i put messageboxes in, the following attachments were found

icons.gif
yellowbg.gif
olicon.GIF
ie.gif
office.gif
exchange.gif
netmeeting.gif
wmt.gif

8 attachments......

What I cant figure out is why it is finding a whole load of image files as attachments when the only attachment that I have is a spreadsheet?

Any more ideas??

from a thoroughly baffled Elise!!!!

 

[RobBroekhuis]

Ah - this may be a difference in your Outlook inbox folder configuration. For me, items(1) is always the most recent one, but for you this may be different. The code may be looking at the wrong mail item. Also, I don't know if the newmail() event fires just once if multiple items are received at the same time, or once for every item. The robust solution to this is to look through the entire inbox every time the newmail event fires, and check the most recent items. It's getting more complex, though. The following works for me:

Private Sub Application_NewMail()
Dim fld As MAPIFolder, mi As MailItem, at As Attachment
Dim LookForFile As String, MyPath As String, NewTime As Date
Static LastChecked As Date
MyPath = "c:\"
NewTime = 0
LookForFile = Format(Date - Weekday(Date) + 2, "dd-mm-yy&quot & ".xls"
Set fld = Application.GetNamespace("MAPI&quot.GetDefaultFolder(olFolderInbox)
For Each mi In fld.Items
If mi.ReceivedTime > LastChecked Then
Debug.Print "checking message: " & mi.Subject
If mi.ReceivedTime > NewTime Then NewTime = mi.ReceivedTime
For Each at In mi.Attachments
If at.FileName = LookForFile Then
at.SaveAsFile MyPath & "\oos.xls"
MsgBox "File received and saved"
End If
Next at
End If
Next mi
If NewTime > 0 Then LastChecked = NewTime
End Sub

I use a static variable (but this could also be configured as a registry entry) to keep track of the most recent mail item checked, so that only new items are scrutinized.


Rob

 

[RobBroekhuis]

Oh, just realized - if the choice of mailitem was the problem, and the e-mail of interest really has only one attachment, then you can remove the inside loop once again, with the if .attachments.count=1 condition.


Rob

 

[EliseFreedman]

Yippee - Got it too work - Thanks for all your help

I decided that your final piece of code looked a bit complicated for me - a newcomer to programming in Outlook.

I got around the problem by setting up a rule to put any email relating to the out of stocks into the draft folder(will make sure that there is only ever one email in there) - I then changed the code to check the drafts folder instead.

Not sure wot the story was with all the background images. It just seemed to disappear without me doing anything.

Thanks again

Elise