2nd outlook question of the day....

[Chris_AAA]

Hi Guys

Posting this in seperate message so that it does not get messy or confusing.

I have a group mail box, which recieves 6 mails in each day....

For example pruposes they are in

Queries Mail Box
Sub Folder 'MS'

Emails are always titles same...

.1
.2
.3
.4
.5
.6

all with xls files.

I would like to extract all email attachments to a folder on my local drive 'Email Folder'
And name each one as
.1 CSV
.2 CSV
.3CSV and so on.

Any help is fully appreciated.

Thanky you kindly.

I have done something (slightly similar for one email as a tester) but this task is slightly beyond my two days outlook vba experience.

[gmayor]

If you want to do this as the messages arrive, you will need to run the macro script from a rule that identifies the messages in question. The script that should do the job is below.

The folder - here shown as "C:\Email Folder\" must exist. Change the address as appropriate.

Your original request was unclear about the naming. As you have written it, the attachments will overwrite any of the same name. If they are the same each time, that may be an issue. To this end I have added a date and time to the filename. It would be possible to number the attachments, but that would require additional code.

The message also says that you want to save as CSV format. The macro saves as XLS, which you indicated was the original format. In order to save as CSV, you are then going to have to open in Excel and save as CSV. Again this can be done in code, but it will slow down the process markedly, so I have not added the code to open Excel, open the attachments in turn and save them, then presumably delete the XLS versions.




Sub SaveXLSAttachments(olItem As Outlook.MailItem)
Dim olAttach As Attachment
Const strSaveFldr As String = "C:\Email Folder\"
On Error GoTo Cleanup
If olItem.Attachments.Count > 0 Then
For Each olAttach In olItem.Attachments
If Right(LCase(olAttach.Filename), 3) = "xls" Then
olAttach.SaveAsFile _
strSaveFldr & Format(Now, "yyyymmdd-HHMMSS") & _
Chr(32) & olAttach.Filename
End If
Next olAttach
End If
Cleanup:
Set olAttach = Nothing
End Sub

[Chris_AAA]

Thats great... i will look at this and see if it works for me....

Thank you so much for your help.

No doubt i will be back on here soon with more questions.... :-)

Have a lovely day.