Consulting

Results 1 to 3 of 3

Thread: 2nd outlook question of the day....

  1. #1

    2nd outlook question of the day....

    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.

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •