Save emails inc attachments from outlook to user defined folder on disk, include naming convention as prefix

Hi all

Users have around 2gb mail each which needs saving to disk to free up space on the e-mail server and also provide ease of access to the information.

I am looking for a VB script to do the following that users can run on their outlook profiles to save information to disk in the right format. (the below is being done manually and taking ages)

1. Save an individual e-mail or folder with lots of e-mails to a specified folder/drive (user needs to navigate to this). e.g. save 1 highlighted e-mail from folder or all e-mails from folder.

2. The e-mail itself as well as any attachments need to be saved

3. When saved, e-mail name needs to have prefix of received date & time in format

YYMMDD space HHMM space then the subject e.g. 100323 1003 testmail

4. E-mail needs to be saved in best format without user intervention (HTML/RTF)

5. Can the script pls include a prompt when complete to browse to the folder they navigated to for the destination ?
LVL 17
SteveIT ManagerAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Commented:
The problem with embedded images is not at all easy to resolve and I have tried a few ways.  Most indications suggest using the redemption add-in as it exposes the necessary detail within outlook but haven't tried it so cannot help without considering a whole new approach.

Chris
0
 
Chris BottomleyCommented:
In principle this can be done using macros.  You indicate a manual process of running but for example it could be triggered on mail receipt to save attachments to a folder and for example add a link to the original email to replace the original attachment ... just as a thought provoking alternative to your request.

Chris
0
 
SteveIT ManagerAuthor Commented:
Thanks for the info, i'd rather retain a "user initiated" solution as this will not apply to everything coming in
0
Easily manage email signatures in Office 365

Managing email signatures in Office 365 can be a challenging task if you don't have the right tool. CodeTwo Email Signatures for Office 365 will help you implement a unified email signature look, no matter what email client is used by users. Test it for free!

 
SteveIT ManagerAuthor Commented:
Found this

http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_20966368.html?sfQueryTermInfo=1+bulk+email+from+outlook+save 

If this script could include the prefixes i require that would do it i think however i'm not a programmer........
0
 
Chris BottomleyCommented:
i'd rather retain a "user initiated" solution as this will not apply to everything coming in

Please explain ... it can be linked to specific sender, specific receiving account, limited by subject header, body contents or any such in combination.  ALl it takes is some processing.  Ideally indicate what you want of it and we can establish a working plan.

Chris
0
 
ComputerBeastCommented:
instead of script you can rather try an Outlook's attachment processor software.
0
 
SteveIT ManagerAuthor Commented:
Also when saving files i need it to not create the folder of HTML files for e-mails or attachments...
0
 
Chris BottomleyCommented:
>>> Also when saving files i need it to not create the folder of HTML files for e-mails or attachments...

Do you not want to look to the VBA method or did you miss the last post asking for clarification?

Chris
0
 
SteveIT ManagerAuthor Commented:
Sorry - me being vague

I want the above to be possible via a button on the outlook toolbar (which is why i was thinking macro/vb).

The main useage for this is to get a load of e-mails saved to a folder; some folders have 1,000 + items in....
0
 
SteveIT ManagerAuthor Commented:
Sorry, to hopefully clarify, this is what i am thinking
  • User highlights either an inidivdual e-mail or folder e.g. inbox and clicks a button on the taskbar then is prompted to browse to a folder.
  • Solution then automatically saves all e-mails to the folder using ReceivedTime YYMMDD HHMM Subject
  • Attachments saved also with the prefix ReceivedTime YYMMDD HHMM filename
  • E-mails to be saved in RTF where possible (avoids html folders being created with styles etc and ensures users can open the files)
ie if a user highlights an e-mail with a subject of TEST and an attachment of PDF.PDF received on 23/03/2010 12:00 then after browsing to the folder the solution saves the file

100323 1200 TEST.rtf
100323 1200 PDF.pdf
0
 
Chris BottomleyCommented:
Button, yes in outlook 2003 it would sit in the menu structure and then can cycle around a given folder the issues are:

1. Which folder ... currently selected, fixed or dynamically selected from a list?
2. WHich emails are to be processed some or all
3. Delete the mails and save to the disk or delete the attachments and replace with a link to the DOS based file(s)?

Chris
0
 
SteveIT ManagerAuthor Commented:
And if it could remember the last folder used that would be ace...
0
 
Chris BottomleyCommented:
Sorry but I have to be persistent as I cannot begin to scope a solution until the requirement takes some structure ... and that is my job in this case:

1. Which outlook folder ... currently selected, fixed or dynamically selected from a list?
2. WHich emails are to be processed some or all
3. Delete the mails and save to the disk or delete the attachments and replace with a link to the DOS based file(s)?

4. WHere should the attachments be saved in the dos structure
5. Remember which folder the dos one of outlook one, potentially a difficult add in for the one question but both are probably doable overall.

Chris
0
 
SteveIT ManagerAuthor Commented:
Hi

Be as persistent as needed

1. selected outlook folder e.g. inbox or currently selected individual item
2. all in folder unless individuals selected (solution based on capabilities of http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_20966368.html?sfQueryTermInfo=1+bulk+email+from+outlook+save )  

3. delete the attachments and replace with link to file (saved on network drive) else leave attachment and mail to be manually deleted by user.

4. Depends, ideally to a folder that the user browses to via gui not having to type in the folder path (ideally the solution would support saving to mapped drive e.g. G drive

5. dos however too much then please ignore.......
0
 
Chris BottomleyCommented:
As a proposal for a bite sized chunk I am personally happy to work on:

1. For the selected outlook folder, if any items selectged then process only those items otherwise process all items in the folder.

2/3. Delete All attachments and replace with link to file (saved on network drive).  If I dentify the path as a constant you will change to reflect your system?

4. The initial solution will save to a specific folder you will identify against 2.

5. Ignoring.

Note however if this is considered acceptable bu you there is nothing to say you cannot return on it's conclusion to ask another couple of questions to improve the solution in respect of the missing features.  I woould however strongly suggest 1 at a time to prevent the code changes overlapping each other.

Let me know if you are happy to proceed as this or otherwise what I have got wrong or that you feel is a critical omission.

Chris
0
 
Chris BottomleyCommented:
FYI, I have rough solution but I was wrong in 1 regard to the possible, I cannot detect if the explorer or the mail item has the focus therefore selective operaqtion will require a rethink i.e.:

If 1 item selected then process all mailitems, if more than 1 selected then process only the selection.  How does that sound?

Chris
0
 
SteveIT ManagerAuthor Commented:
Sounds good to me................
 
0
 
Chris BottomleyCommented:
oOkay the following looks as though it meets my understanding so as a starter take the following code and place it into a normal code module in the outlook VBE.

Chris
Sub LinkMailtosavedAttachment()
Dim testObj As Object
Dim mai As MailItem
Dim attcount As Long
Dim saveAttAs(1 To 3) As String
Dim DOSFile As String
Dim verNumber As Long
Dim dosFolder As String
Dim collectionItems As Object
Const savePath As String = "c:\deleteme"

    dosFolder = Trim(savePath)
    md dosFolder, True
    If Right(dosFolder, 1) <> "\" Then dosFolder = dosFolder & "\"

    On Error GoTo errorbit
    If TypeName(Application.ActiveWindow) = "Explorer" Then
        Set collectionItems = Application.ActiveExplorer.Selection
        If Application.ActiveExplorer.Selection.count = 1 Then
            Set collectionItems = Application.ActiveExplorer.CurrentFolder.Items
        Else
            Set collectionItems = Application.ActiveExplorer.Selection
        End If
    ElseIf TypeName(Application.ActiveWindow) = "Inspector" Then
        Set collectionItems = Application.ActiveInspector.CurrentItem
    Else
        Exit Sub
    End If
    For Each testObj In collectionItems
        If testObj.Class = olMail Then
            On Error GoTo receive_encrypted ' Assumes if there is a read error that the email is encrypted and skips the mail
            ' Process email
            Set mai = testObj
            ' Cycle around each attachment in the email ... mai is the currently processed email
            For attcount = mai.Attachments.count To 1 Step -1
                ' Need to allow for re-issues of same name so use an incremental affix to the name component
                On Error GoTo assumeEmbedded
                verNumber = 1
                saveAttAs(1) = dosFolder
                saveAttAs(1) = saveAttAs(1) & Left(mai.Attachments.Item(attcount).FileName, InStrRev(mai.Attachments.Item(attcount).FileName, ".") - 1)
                saveAttAs(2) = "_" & verNumber
                saveAttAs(3) = Right(mai.Attachments.Item(attcount).FileName, Len(mai.Attachments.Item(attcount).FileName) - InStrRev(mai.Attachments.Item(attcount).FileName, ".") + 1)
                DOSFile = Dir(Join(saveAttAs, ""))
                Do While DOSFile <> ""
                    'That file name found so increment affix
                    verNumber = verNumber + 1
                    saveAttAs(2) = "_" & verNumber
                    DOSFile = Dir(Join(saveAttAs, ""))
                Loop
                ' save the attachment as a dos file
                mai.Attachments.Item(attcount).SaveAsFile Join(saveAttAs, "")
                ' delete from the emai
                If mai.BodyFormat = olFormatHTML Then
                    mai.HTMLBody = mai.HTMLBody & vbCrLf & "<a href='file://" & Join(saveAttAs, "") & "'>" & Join(saveAttAs, "") & "</a>"
                Else
                    mai.body = mai.body & vbCrLf & "<file://" & Join(saveAttAs, "") & ">"
                End If
                mai.Attachments.Item(attcount).Delete
                mai.Save    ' Replace mai with attachments by mai with links
assumeEmbedded:
            Next
            mai.Save    ' Replace mai with attachments by mai with links
        Else
        ' Message not found
        End If
receive_encrypted:
    Next
    Set testObj = Nothing
    Set mai = Nothing
    GoTo exiat
errorbit:
    Debug.Print "Error Detected - " & err.Number & ", (" & err.description & ")"
    Stop
    Resume Next
exiat:
endex:

End Sub


Function md(dosPath As String, Optional createFolders As Boolean)
Dim FSO As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer

    md = True
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not FSO.FolderExists(rootdir) Then
            md = False
            Exit Function
        End If

        For fldrIndex = 1 To UBound(fldrs)
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not FSO.FolderExists(rootdir) Then
                If createFolders Then
                    FSO.CreateFolder rootdir
                Else
                    md = False
                End If
            End If
        Next
        Exit Function
    End If
End Function

Open in new window

0
 
Chris BottomleyCommented:
To Create a macro:
------------------

Alt + F11 to open the macro editor

  For User Code:
     Insert | Module to insert a code module into the project
     In the project tree select the module.
     Insert the required macro(s) into the selected module, ('Module1' or similar)

Close the Visual Basic Editor.

Check Security as appropriate:
------------------------------

In the application select Tools | Macro | Security
2003 and Earlier : Select Medium
2007 : Warnings for all Macros
Select OK

To run a macro:
---------------

Alt + F8
Select the macro
Select 'Run'

Chris
0
 
Chris BottomleyCommented:
To implement a calling button on the outlook interface:

1. Right click the menu area and select customise
2. Toolbars | new Give it a name and drag to the menu area
3. Commands | MAcros and navigate to the LinkMailtosavedAttachment macro ... drag this onto the menu you just added.

Chris
0
 
SteveIT ManagerAuthor Commented:
Thanks
 
Just run and if e-mail has attachment it copies it to c:\deleteme
0
 
SteveIT ManagerAuthor Commented:
Just run again, doesn't appear to affect the e-mails ....

Am i doing something wrong ?
0
 
SteveIT ManagerAuthor Commented:
Ah - it puts a link to the file in the e-mail......
0
 
Chris BottomleyCommented:
I did say "I dentify the path as a constant you will change to reflect your system?"

I did not say how ... apologies edit the line:
Const savePath As String = "c:\deleteme"
to reflect your required save folder.

>>> Ah - it puts a link to the file in the e-mail......
I did say that was the counter proposal as it keeps everything together but chops the PST down dramatically.

Chris
0
 
SteveIT ManagerAuthor Commented:
Ah - thanks for the heads up

Saves files a treat, puts them in the folder c:\deleteme (or alternative if specified) and puts a link into the e-mail to keep everything linked in....


0
 
SteveIT ManagerAuthor Commented:
Just thinking if i move files then the links wont work - is it possible for the script to save the attachment in the same folder ? with both using the naming conventions above ?

Thank you for the assist so far :)
0
 
Chris BottomleyCommented:
>>> it possible for the script to save the attachment in the same folder ...
Same folder as what?

Chris
0
 
SteveIT ManagerAuthor Commented:
as the e-mail, detailed in the above, sorry i keep not being specific .. ........


0
 
Chris BottomleyCommented:
The email isn't being saved to dos as I suggested it is kept in outlook so you have a full thread.  A different approach would be to save the email as a dos file of the msg type but I thought the agreement was for keeping the mail itself in outlook.  DId I misunderstand the final decision?

Chris
0
 
Chris BottomleyCommented:
I guess you are not available ... so before the same happens to me this code saves all selected emails as is to the defined dos folder.  Once that is done the mail item is deleted.  If the deletion is not required then delete the line:

        testObj.Delete

Select the mails/folder as before and then run the sub cycleFolderItems ... modify the button to refer to this sub once you are happy.

Chris
Sub cycleFolderItems()
Dim testObj As Object
Dim collectionItems As Object
Dim itemCount As Integer

    On Error GoTo errorbit
    If TypeName(Application.ActiveWindow) = "Explorer" Then
        Set collectionItems = Application.ActiveExplorer.Selection
        If Application.ActiveExplorer.Selection.count = 1 Then
            Set collectionItems = Application.ActiveExplorer.CurrentFolder.Items
        Else
            Set collectionItems = Application.ActiveExplorer.Selection
        End If
    ElseIf TypeName(Application.ActiveWindow) = "Inspector" Then
        Set collectionItems = Application.ActiveInspector.CurrentItem
    Else
        Exit Sub
    End If
    For itemCount = collectionItems.count To 1 Step -1
        Set testObj = collectionItems(itemCount)
        If testObj.Class = olMail Then
            On Error GoTo receive_encrypted ' Assumes if there is a read error that the email is encrypted and skips the mail
            ' Process email
            saveMailItemtoDOS testObj
        End If
        testObj.Delete
receive_encrypted:
    Next
    Set testObj = Nothing
    GoTo exiat
errorbit:
    Debug.Print "Error Detected - " & err.Number & ", (" & err.description & ")"
    Stop
    Resume Next
exiat:
endex:

End Sub

Sub saveMailItemtoDOS(mai As MailItem)
Dim dosFolder As String
Dim verNumber As Integer
Dim saveAttAs(1 To 3) As String
Dim DOSFile As String
Const savePath As String = "c:\deleteme"
    
    dosFolder = Trim(savePath)
    md dosFolder, True
    If Right(dosFolder, 1) <> "\" Then dosFolder = dosFolder & "\"
    verNumber = 1
    saveAttAs(1) = dosFolder
    saveAttAs(1) = saveAttAs(1) & FixPath(mai.Subject)
    saveAttAs(2) = "_" & verNumber
    If mai.BodyFormat = olFormatHTML Then
        saveAttAs(3) = ".htm" ', olHTML
    ElseIf mai.BodyFormat = olFormatRichText Then
        saveAttAs(3) = ".rtf" ', olRTF
    Else
        saveAttAs(3) = ".msg" ', olMSG
    End If
    DOSFile = Dir(Join(saveAttAs, ""))
    Do While DOSFile <> ""
        'That file name found so increment affix
        verNumber = verNumber + 1
        saveAttAs(2) = "_" & verNumber
        DOSFile = Dir(Join(saveAttAs, ""))
    Loop
    If mai.BodyFormat = olFormatHTML Then
        mai.saveas Join(saveAttAs, ""), olHTML
    ElseIf mai.BodyFormat = olFormatRichText Then
        mai.saveas Join(saveAttAs, ""), olRTF
    Else
        mai.saveas Join(saveAttAs, ""), olMsg
    End If

End Sub

Function FixPath(strPath As String) As String
    Dim varIllegalChars As Variant, _
        intCharacter As Integer
    varIllegalChars = Array("[", "]", "=", "+", ",", "*", "/", ":", "<", ">", "?", "\", "|", ".", """", vbNull)
    For intCharacter = LBound(varIllegalChars) To UBound(varIllegalChars)
        If InStr(1, strPath, varIllegalChars(intCharacter)) > 0 Then
            strPath = Replace(strPath, varIllegalChars(intCharacter), "")
        End If
    Next
    FixPath = strPath
End Function

Open in new window

0
 
SteveIT ManagerAuthor Commented:
Hi

Apologies for the unavailability, got called back into work.....

Thanks for the new code, however i get the attached compile error - have i missed something ? (sorry code not my strong suit)

Please advise

compile.JPG
0
 
Chris BottomleyCommented:
Yes and no.  I had a computer issue mid post so I did mean to say keep the md function from the earlier post.

Copied here for ease.

Chris
Function md(dosPath As String, Optional createFolders As Boolean) 
Dim FSO As Object 
Dim fldrs() As String 
Dim rootdir As String 
Dim fldrIndex As Integer 
 
    md = True 
    Set FSO = CreateObject("Scripting.FileSystemObject") 
    If Not FSO.FolderExists(dosPath) Then 
        fldrs = Split(dosPath, "\") 
        rootdir = fldrs(0) 
        If Not FSO.FolderExists(rootdir) Then 
            md = False 
            Exit Function 
        End If 
 
        For fldrIndex = 1 To UBound(fldrs) 
            rootdir = rootdir & "\" & fldrs(fldrIndex) 
            If Not FSO.FolderExists(rootdir) Then 
                If createFolders Then 
                    FSO.CreateFolder rootdir 
                Else 
                    md = False 
                End If 
            End If 
        Next 
        Exit Function 
    End If 
End Function

Open in new window

0
 
SteveIT ManagerAuthor Commented:
Thanks - chris - you rock :)

* One of the mails had a PDF attachment that wasn't saved into the folder for some reason..

* Is it possible to save the mails as RTF (in the destination folder i'm getting folders for each mail that contain themedata, colorscheme mapping and filelist which i don't want in there)

* Is it possible to add the prefix of the Received time YYMMDD in front of the saved files and attachments (this would complete the solution)
0
 
Chris BottomleyCommented:
As it stands:

1. The original solution saved the attachments, so as to keep a connection between the mail folder and the saved items.  This one saves the emails COMPLETE WITH attachments, i.e. still in the mail.

2. Yes.

3. Yes ... but as I said the attachments are not saved seperately.

Note removing the attachments creates a problem in that it is difficult to know which attachment releates to which email ... even with a date prefix but if that is what you want ...

Chris
0
 
SteveIT ManagerAuthor Commented:
After checking this end, apparently provided the attachment is in the same folder then it is not essential that it is linked uniquely to the parent e-mail.

I really like the idea of having the mail with the linked in items however when going into a folder a user needs to see all correspondence.

Date prefix of received on mail and separate attachments would allow near-matching which i believe will suffice.

Thanks and thank you for your help with this ..
0
 
SteveIT ManagerAuthor Commented:
oh and RTF saving will get rid of all those annoying folders....
0
 
Chris BottomleyCommented:
HAven't tested but this hopefully does that, again replace for the save folder and I have hopefully included a full set of code to avoid the problem of last time.

Chris
Sub cycleFolderItems_2()
Dim testObj As Object
Dim collectionItems As Object
Dim itemCount As Integer

    On Error GoTo errorbit
    If TypeName(Application.ActiveWindow) = "Explorer" Then
        Set collectionItems = Application.ActiveExplorer.Selection
        If Application.ActiveExplorer.Selection.count = 1 Then
            Set collectionItems = Application.ActiveExplorer.CurrentFolder.Items
        Else
            Set collectionItems = Application.ActiveExplorer.Selection
        End If
    ElseIf TypeName(Application.ActiveWindow) = "Inspector" Then
        Set collectionItems = Application.ActiveInspector.CurrentItem
    Else
        Exit Sub
    End If
    For itemCount = collectionItems.count To 1 Step -1
        Set testObj = collectionItems(itemCount)
        If testObj.Class = olMail Then
            On Error GoTo receive_encrypted ' Assumes if there is a read error that the email is encrypted and skips the mail
            ' Process email
            SavePartsasDOS testObj
        End If
        testObj.Delete
receive_encrypted:
    Next
    Set testObj = Nothing
    GoTo exiat
errorbit:
    Debug.Print "Error Detected - " & err.Number & ", (" & err.description & ")"
    Stop
    Resume Next
exiat:
endex:

End Sub

Sub SavePartsasDOS(mai As MailItem)
Dim dosFolderPath As String
Dim intIncrement As Integer
Dim intAtt As Integer
Dim att As Attachment
Dim fn As String
Dim ft As String
Dim FSO As Object
Dim maiDate As String

    dosFolderPath = "c:\deleteme\"
    If Right(dosFolderPath, 1) <> "\" Then dosFolderPath = dosFolderPath & "\"
        Set FSO = CreateObject("scripting.filesystemobject")
        md dosFolderPath, True
        For intAtt = mai.Attachments.count To 1 Step -1
            Set att = mai.Attachments(intAtt)
            intIncrement = 1
            fn = Left(att.FileName, InStrRev(att.FileName, ".") - 1)
            ft = Right(att.FileName, Len(att.FileName) - InStrRev(att.FileName, ".") + 1)
            Do While FSO.FileExists(dosFolderPath & fn & "_" & intIncrement & ft)
                intIncrement = intIncrement + 1
            Loop
            att.SaveAsFile dosFolderPath & fn & "_" & intIncrement & ft
            att.Delete
        Next
        mai.Save
        mai.BodyFormat = olFormatRichText
        mai.saveas dosFolderPath & Format(mai.ReceivedTime, "yyyy mm dd") & FixPath(mai.Subject) & ".rtf", olRTF

Set FSO = Nothing
End Sub

Function FixPath(strPath As String) As String
    Dim varIllegalChars As Variant, _
        intCharacter As Integer
    varIllegalChars = Array("[", "]", "=", "+", ",", "*", "/", ":", "<", ">", "?", "\", "|", ".", """", vbNull)
    For intCharacter = LBound(varIllegalChars) To UBound(varIllegalChars)
        If InStr(1, strPath, varIllegalChars(intCharacter)) > 0 Then
            strPath = Replace(strPath, varIllegalChars(intCharacter), "")
        End If
    Next
    FixPath = strPath
End Function

Function md(dosPath As String, Optional createFolders As Boolean)
Dim FSO As Object
Dim fldrs() As String
Dim rootdir As String
Dim fldrIndex As Integer

    md = True
    Set FSO = CreateObject("Scripting.FileSystemObject")
    If Not FSO.FolderExists(dosPath) Then
        fldrs = Split(dosPath, "\")
        rootdir = fldrs(0)
        If Not FSO.FolderExists(rootdir) Then
            md = False
            Exit Function
        End If

        For fldrIndex = 1 To UBound(fldrs)
            rootdir = rootdir & "\" & fldrs(fldrIndex)
            If Not FSO.FolderExists(rootdir) Then
                If createFolders Then
                    FSO.CreateFolder rootdir
                Else
                    md = False
                End If
            End If
        Next
        Exit Function
    End If
End Function

Open in new window

0
 
SteveIT ManagerAuthor Commented:
Fantastic - almost perfect...

The code adds the date e.g. 2010 03 24 - can this be YYMMDD without any spaces ?
There was a PDF attachment that didn't get the prefix
None of the e-mails themselves were saved.

Cheers
0
 
SteveIT ManagerAuthor Commented:
But all of the e-mails were deleted even though i removed the         testObj.Delete
0
 
SteveIT ManagerAuthor Commented:
ignore "None of the e-mails themselves were saved" comment as they are all in the right place
0
 
Chris BottomleyCommented:
There is no logic to the PDF issue, all attachments are treated as files.  The attachments however did not get the prefix so maybe that's it.  Just the one sub changed so replace SavePartsasDOS with the snippet below.

Chris
Sub SavePartsasDOS(mai As MailItem)
Dim dosFolderPath As String
Dim intIncrement As Integer
Dim intAtt As Integer
Dim att As Attachment
Dim fn As String
Dim ft As String
Dim FSO As Object
Dim maiDate As String

    dosFolderPath = "c:\deleteme\test2"
    If Right(dosFolderPath, 1) <> "\" Then dosFolderPath = dosFolderPath & "\"
        Set FSO = CreateObject("scripting.filesystemobject")
        md dosFolderPath, True
        For intAtt = mai.Attachments.count To 1 Step -1
            Set att = mai.Attachments(intAtt)
            intIncrement = 1
            fn = Format(mai.ReceivedTime, "yymmdd ") & Left(att.FileName, InStrRev(att.FileName, ".") - 1)
            ft = Right(att.FileName, Len(att.FileName) - InStrRev(att.FileName, ".") + 1)
            Do While FSO.FileExists(dosFolderPath & fn & "_" & intIncrement & ft)
                intIncrement = intIncrement + 1
            Loop
            att.SaveAsFile dosFolderPath & fn & "_" & intIncrement & ft
            att.Delete
        Next
        mai.Save
        mai.BodyFormat = olFormatRichText
        mai.saveas dosFolderPath & Format(mai.ReceivedTime, "yymmdd") & FixPath(mai.Subject) & ".rtf", olRTF

Set FSO = Nothing
End Sub

Open in new window

0
 
SteveIT ManagerAuthor Commented:
Looking good, the files are named correctly and the attachments are also - very impressive.

Final query - is it possible to have the script run on a selected file individually rather than all mail in the folder - is there a switch/parameter that can be changed to only process e.g. 10 highlighted e-mails in a folder - or is this more complicated ??
0
 
Chris BottomleyCommented:
It already should select specific items as I have tried to maintain that through each variant i.e. as agreed at the outset:

Select 1 item - all items in the folder processed.
Select multiple items - only the selected items should be processed.

Are you saying this doesn't work in the latest version?

Chris
0
 
SteveIT ManagerAuthor Commented:
It extracts everything if i highlight 1 item but also extracts everything if i highlight multiple items..


0
 
Chris BottomleyCommented:
I cannot see how ... I have just tested on mine and it selects as many as as are selected.  I need to try it on a 2003 machine as perhaps that is the problem  - though I have used the same structure before without difficukties.

Chris
0
 
Chris BottomleyCommented:
I've just run it on 2003 using xp and it works as advertised.  Select 1 item and all are processed.  Select multiple items and the selection is run.

To be sure - you are running cycleFolderItems_2?

Chris
0
 
SteveIT ManagerAuthor Commented:
Hi

Yes and it currently extracts everything in the folder not just the individually selected/highlighted items.

Its also saving any pictures for the message (e.g. signatures or logos) separately - should these not be in the RTF files ?

e.g. i have just run this on a folder with 500 e-mails in and it worked :) - e-mails and attachments were saved correctly however i had 300 images that were logos etc from any HTML signatures. - do i have to delete these separately?
0
 
SteveIT ManagerAuthor Commented:
Just trying another PC - this does work as you promised - if 1 selected it does the folder, if multiple selected it does multiple. Must be a problem with my other PC - solution DOES work :)
I may be having a bit of a blonde moment but i am still getting separate images that were logos etc from any HTML signatures. - can these be embedded into the rtf or html or deleted ?  
 
0
 
SteveIT ManagerAuthor Commented:
Not to worry, for the sake of a few easily identifyable images (usually GIF's) these can be manually purged....

Thanks for the assist, points on their way
0
 
SteveIT ManagerAuthor Commented:
Awesome
0
All Courses

From novice to tech pro — start learning today.