Solved

How to save email on a dvd

Posted on 2006-07-18
20
916 Views
Last Modified: 2011-08-18
Hi,

I'm using outlook 2002 and want to save, copy or export a whole folder and than i want to copy it to a dvd.
It is necessary that i can browse the emails on the dvd and read them (with attachments) without using outlook.
So i don't want to export the pst-files and then import them to read the mail.

greetings

Stefaan
1pc
0
Comment
Question by:1pc
  • 9
  • 8
  • 2
  • +1
20 Comments
 
LVL 20

Expert Comment

by:Dufo G. Belski
Comment Utility
0
 

Author Comment

by:1pc
Comment Utility
This doesn't help me. It requires outlook to be installed on the computer.
I want to view the emails without outlook installed.
0
 
LVL 97

Expert Comment

by:war1
Comment Utility
Greetings, 1pc !

You need Outlook to read Outlook messages.  Outlook message or file is proprietary, so only Outlook could read an email.

Instead of backing of the PST file, you can drag and drop the emails to an empty folder.  They will appear as .msg files. But you still need Outlook program to view them.

Best wishes!
0
 
LVL 20

Expert Comment

by:Dufo G. Belski
Comment Utility
Exactly.
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Hi 1pc,

The alternative is to export every message to plain-text or HTML format, along with it's attachments to a folder structure.  You could then copy/move the folders to DVD.  Outlook does not have this capability built-in, so it will require a bit of scripting.  If you want to go that route, then I can help with the scripting.

Cheers!
0
 

Author Comment

by:1pc
Comment Utility
Hi BlueDevilFan,

Can i than export all the messages at once?

Greetings
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
1pc,

Absolutely.
0
 

Author Comment

by:1pc
Comment Utility
Ok i will try this but you have to explain it very well because i know nothing about scripts.

0
 

Author Comment

by:1pc
Comment Utility
I prefer HTML-format

Greetings

Stefaan

1pc
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
1pc,

Ok, here it is.  Follow these instructions to set up and use it.

1.  Start Outlook.
2.  Click Tools->Macro->Visual Basic Editor.
3.  If not already expanded, expand Modules and click on Module1.
4.  Copy the code below and paste it into the right-hand pane of the VB Editor.
5.  Edit the code as needed.  I placed comment lines where things can change.
6.  Click the diskette icon on the toolbar to save the changes.
7.  Close the VB Editor.
8.  Click Tools->Macro->Security.
9.  Change the Security Level setting to Medium.
10.  You're ready to go.

To use it:

1.  Select a folder by clicking on it.
2.  Click tools->Macro->Macros
3.  Select ExportFolderToFileSystem and click Run.
4.  A dialog-box will pop up asking you to browse to a folder in the file system.  This is the folder that'll hold the exported items.
5.  The code will now export all messages and attachments in the selected Outlook folder.  It will not process sub-folders.  The process creates a sub-folder for each message.  The structure will look like this:

    Starting Folder
    +MSG000001
      - Message.htm
      - Attachment1
      - Attachment2
    +MSG000002
      - Message.htm

The process of exporting messages is going to trigger Outlook's built-in security.  This will pop up a dialog-box warning that a program is accessing your mailbox and asking for your permission to allow it to continue.  You have to allow access for this to work.

Sub ExportFolderToFileSystem()
    Dim olkFolder As Object, _
        olkItems As Object, _
        olkItem As Object, _
        olkAttachment As Object, _
        objFSO As Object, _
        objFSFolder As Object, _
        objTemp As Object, _
        strFolder As String
    Set olkFolder = Application.ActiveExplorer.CurrentFolder
    Set olkItems = olkFolder.Items
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the starting folder on the following line as desired
    strFolder = GetFolderName("C:\")
    Set objFSFolder = objFSO.GetFolder(strFolder)
    For Each olkItem In olkItems
        Set objTemp = objFSFolder.SubFolders.Add("MSG" & StrZero(objFSFolder.SubFolders.Count + 1, 6))
        olkItem.SaveAs objTemp.Path & "\Message.htm"
        For Each olkAttachment In olkItem.Attachments
            olkAttachment.SaveAsFile objTemp.Path & "\" & olkAttachment.FileName
        Next
    Next
    Set objTemp = Nothing
    Set objFSFolder = Nothing
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkItem = Nothing
    Set olkItems = Nothing
    Set olkFolder = Nothing
    MsgBox "All done!"
End Sub

Function GetFolderName(strStartingFolder As Variant) As String
    Const WINDOW_HANDLE = 0
    Const NO_OPTIONS = 0
    Dim objShell As Object, _
        objFolder As Object, _
        objFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, strStartingFolder)
    If Not TypeName(objFolder) = "Nothing" Then
        Set objFolderItem = objFolder.self
        GetFolderName = objFolderItem.Path & "\"
    Else
        GetFolderName = ""
    End If
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Function

Function StrZero(varNumber As Variant, intLength As Integer) As String
    Dim intItemLength As Integer, _
        intDifference As Integer
    If IsNumeric(varNumber) Then
        intItemLength = Len(CStr(Int(varNumber)))
        If intItemLength < intLength Then
            intDifference = intLength - intItemLength
            StrZero = String(intDifference, "0") & varNumber
        Else
            StrZero = varNumber
        End If
    Else
        StrZero = varNumber
    End If
End Function
0
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 

Author Comment

by:1pc
Comment Utility
BleuDevilFan,

It works but the messages are unreadable. See example below.
And isn't it possible to change the foldernames in the name of the shipper?

example:
ÐÏࡱá>þÿ þÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿRoot Entryÿÿÿÿÿÿÿÿ@ÈÆíèªÆ€ __properties_version1.00.ÿÿÿÿV__nameid_version1.0(ÿÿÿÿÿÿÿÿ?@WÄíèªÆ@ÈÆíèªÆ__substg1.0_0E04001E*ÿÿÿÿ4ÿÿÿÿýÿÿÿÿÿÿÿÿÿÿÿ '" !þÿÿÿ#$%&(þÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿRoot Entryÿÿÿÿÿÿÿÿ ÀF@ÈÆíèªÆ€ __properties_version1.00.ÿÿÿÿV__nameid_version1.0(ÿÿÿÿÿÿÿÿ?@WÄíèªÆ@ÈÆíèªÆ__substg1.0_0E04001E*ÿÿÿÿ4ÿÿÿÿÿÿÿÿÿÿÿÿýÿÿÿ '" !þÿÿÿ#$%&(þÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ__substg1.0_0E03001E*$ÿÿÿÿ__substg1.0_0E02001E*ÿÿÿÿÿÿÿÿÿÿÿÿ__recip_version1.0_#00000000:ÿÿÿÿÿÿÿÿ7@WÄíèªÆ@ÈÆíèªÆ__substg1.0_001A001E*ÿÿÿÿU __substg1.0_0037001E*ÿÿÿÿÿÿÿÿÿÿÿÿT__substg1.0_003B0102* ÿÿÿÿS"__substg1.0_003F0102*2ÿÿÿÿÿÿÿÿQD__substg1.0_0040001E* ÿÿÿÿP__substg1.0_00410102*ÿÿÿÿÿÿÿÿÿÿÿÿNL__substg1.0_0042001E* ÿÿÿÿM__substg1.0_00430102*ÿÿÿÿÿÿÿÿÿÿÿÿKD__substg1.0_0044001E*ÿÿÿÿJ__substg1.0_00510102*ÿÿÿÿÿÿÿÿÿÿÿÿI__substg1.0_00520102*ÿÿÿÿH__substg1.0_0064001E*ÿÿÿÿÿÿÿÿÿÿÿÿG__substg1.0_0065001E*ÿÿÿÿF__substg1.0_0070001E*ÿÿÿÿÿÿÿÿÿÿÿÿE__substg1.0_0075001E* ÿÿÿÿD__substg1.0_0076001E*ÿÿÿÿÿÿÿÿÿÿÿÿC__substg1.0_0077001E*ÿÿÿÿB__substg1.0_0078001E*ÿÿÿÿÿÿÿÿÿÿÿÿA__substg1.0_007D001E*ÿÿÿÿ,__substg1.0_0C190102*ÿÿÿÿÿÿÿÿÿÿÿÿ*L__substg1.0_0C1A001E*ÿÿÿÿ)__substg1.0_0C1D0102*ÿÿÿÿÿÿÿÿÿÿÿÿ("__substg1.0_0C1E001E*ÿÿÿÿ'__substg1.0_0C1F001E*ÿÿÿÿÿÿÿÿ&__substg1.0_0E28001E*ÿÿÿÿÿÿÿÿ%0__substg1.0_0E29001E*"ÿÿÿÿ$0__substg1.0_1000001E*ÿÿÿÿÿÿÿÿÿÿÿÿ í__substg1.0_1008001E*!#ÿÿÿÿe__substg1.0_10090102*ÿÿÿÿÿÿÿÿÿÿÿÿm__substg1.0_1035001E* (ÿÿÿÿ-__substg1.0_300B0102*ÿÿÿÿ3ÿÿÿÿ__substg1.0_65A0001E*%'ÿÿÿÿ__substg1.0_8001001E*ÿÿÿÿÿÿÿÿÿÿÿÿ__substg1.0_8002001E*&,ÿÿÿÿ"__substg1.0_80030102*ÿÿÿÿÿÿÿÿÿÿÿÿB__substg1.0_80040102*)+ÿÿÿÿ__substg1.0_8005001E*ÿÿÿÿÿÿÿÿÿÿÿÿ __substg1.0_8006001E**ÿÿÿÿ__substg1.0_80070102*ÿÿÿÿÿÿÿÿÿÿÿÿ ì__substg1.0_8008001E*-0ÿÿÿÿ =__substg1.0_8009001E*ÿÿÿÿÿÿÿÿÿÿÿÿ__substg1.0_800A001E*/1ÿÿÿÿ__substg1.0_800B001E*ÿÿÿÿÿÿÿÿÿÿÿÿ__substg1.0_003D001E*ÿÿÿÿÿÿÿÿÿÿÿÿ__substg1.0_34140102*ÿÿÿÿÿÿÿÿÿÿÿÿ__substg1.0_0E1D001E*ÿÿÿÿÿÿÿÿÿÿÿÿ__properties_version1.00:ÿÿÿÿÿÿÿÿxˆ__substg1.0_0FFF0102*;ÿÿÿÿÿÿÿÿvS__substg1.0_3001001E*69ÿÿÿÿuþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿ þÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿ!"#þÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿ+þÿÿÿ-./0123456789:;<=>?@þÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿLþÿÿÿþÿÿÿOþÿÿÿþÿÿÿRþÿÿÿþÿÿÿþÿÿÿþÿÿÿWXYZ[\]^_`abcdefþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿþÿÿÿwþÿÿÿyzþÿÿÿ|}~þÿÿÿ€adreswijzigingspaarenadvies@virusfree.beNITAù¿¸ª7Ùn[evelinebovenkerk@hotmail.com]evelinebovenkerk@hotmail.com[62.163.196.134]09 Jul 2006 08:32:37.0444 (UTC) FILETIME=[3BD98040:01C6A332]Geachte heer/ mevrouw, Hierbij wil ik mijn adreswijziging doorgeven. Per 01-01-2005 woon ik al op het volgende adres: Gen. de Gaullelaan 30 5623 KT Eindhoven Tel: 06-10400750 Met vriendelijke groeten, Eveline Bovenkerk 452335157452335157POP://pop.virusfree.be/45233515700000006spaaradvies@virusfree.bespaarenadvies+b20060709083337452335157é°ª9áÄÔMŽ)¢‹€1iLZFu 8, rcpg125â2CtexA÷ÿ €¤ä€óPV?U²%Qchá Àset2Ã%ö3F·0,3ï ÷¶;05" `cP3 d36P ¦ GJeÐh° h àr/ €v`uw, ¢ „ €H‘bijæ ð ikÀ`  ad ájzig¡ €g do°gà ð. P01-ó"1Ð05€!P Ññ@ op ã €p@¶vð!€n D:Tð!Á$ÁGaull6e `‘3@c56€23 KT E €Xdho!¡TT&€:A" 6-104" 7v5&õTM$2$±lí`kP Ào ðEÖE! +@nPB(2+p,rkZT}.ÀGEACHTEHEER/MEVROUW,HIERBIJWILIKMIJNADRESWIJZIGINGDOORGEVENPER01-01-2005WOONIKALOPHETVOLGENDEADRES:GGeachte heer/ mevrouw, Hierbij wil ik mijn adreswijziging doorgeven. Per 01-01-2005 woon ik al op het volgende adres: Gen. de Gaullelaan 30 5623 KT Eindhoven Tel: 06-10400750 Met vriendelijke groeten, Eveline Bovenkerk 00000006spaaradvies@virusfree.bespaarenadvies00000006spaaradvies@virusfree.bespaarenadviesevelinebovenkerk@hotmail.comSMTPSMTP:EVELINEBOVENKERK@HOTMAIL.COMEveline Bovenkerk+¤¾£nÝTEveline BovenkerkSMTPevelinebovenkerk@hotmail.comReceived: from q.em.be [193.121.228.20] by KEY.BE with ESMTP (SMTPD-8.21) id AF33DC494; Sun, 09 Jul 2006 10:32:51 +0200 Received: from bay0-omc1-s6.bay0.hotmail.com (www-test.bay2.hotmail.com [65.54.246.78] (may be forged)) by q-eth1.em.be (8.10.2/8.10.2) with ESMTP id k698WhH06324 for ; Sun, 9 Jul 2006 10:32:44 +0200 Received: from hotmail.com ([65.54.229.19]) by bay0-omc1-s6.bay0.hotmail.com with Microsoft SMTPSVC(6.0.3790.1830); Sun, 9 Jul 2006 01:32:37 -0700 Received: from mail pickup service by hotmail.com with Microsoft SMTPSVC; Sun, 9 Jul 2006 01:32:37 -0700 Message-ID: Received: from 65.54.229.220 by by110fd.bay110.hotmail.msn.com with HTTP; Sun, 09 Jul 2006 08:32:35 GMT X-Originating-IP: [62.163.196.134] X-Originating-Email: [evelinebovenkerk@hotmail.com] X-Sender: evelinebovenkerk@hotmail.com From: "Eveline Bovenkerk" To: spaarenadvies@virusfree.be Subject: adreswijziging Date: Sun, 09 Jul 2006 08:32:35 +0000 Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1; format=flowed X-OriginalArrivalTime: 09 Jul 2006 08:32:37.0444 (UTC) FILETIME=[3BD98040:01C6A332] X-RCPT-TO: Status: U X-UIDL: 452335157 spaaradvies@virusfree.beSMTPspaaradvies@virusfree.beSMTPadreswijzigingevelinebovenkerk@hotmail.comSMTPSMTP:SPAARADVIES@VIRUSFREE.BESMTP:SPAARADVIES@VIRUSFREE.BEspaarenadvies+¤¾£nÝTspaarenadviesSMTPspaaradvies@virusfree.beEveline Bovenkerk+¤¾£nÝTEveline BovenkerkSMTPevelinebovenkerk@hotmail.comspaarenadvies+¤¾£nÝTspaarenadviesSMTPspaaradvies@virusfree.beSMTP:EVELINEBOVENKERK@HOTMAIL.COMadreswijzigingIPM.Note@0@WÄíèªÆ@0@WÄíèªÆ÷ô__substg1.0_3002001E*ÿÿÿÿÿÿÿÿÿÿÿÿt__substg1.0_3003001E*85ÿÿÿÿs__substg1.0_300B0102*ÿÿÿÿÿÿÿÿÿÿÿÿr __substg1.0_0FF60102*ÿÿÿÿÿÿÿÿÿÿÿÿq__substg1.0_00020102*ÿÿÿÿÿÿÿÿÿÿÿÿ@__substg1.0_00030102*<>ÿÿÿÿ`__substg1.0_00040102*ÿÿÿÿHÿÿÿÿ{ê__substg1.0_10010102*=@ÿÿÿÿp__substg1.0_10140102*BAÿÿÿÿo__substg1.0_10150102*ÿÿÿÿEÿÿÿÿn__substg1.0_10060102*DCÿÿÿÿm__substg1.0_100B0102*FGÿÿÿÿl__substg1.0_10020102*ÿÿÿÿÿÿÿÿÿÿÿÿk__substg1.0_10180102*ÿÿÿÿÿÿÿÿÿÿÿÿj__substg1.0_10080102*ÿÿÿÿÿÿÿÿÿÿÿÿi__substg1.0_100D0102*ÿÿÿÿÿÿÿÿÿÿÿÿh__substg1.0_10000102*ÿÿÿÿÿÿÿÿÿÿÿÿgÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ 7@9€“d:2£Æ;"Þ?DÝ@ALÝBCDÞDQÝRÞdepuvwx} LÝ  "Þ  @€ûíC2£Æ (0)0í$£#¹e mì5- 0ÜÞ?¯o e€@€€"€B݀݀ €€ìÞ€= € € €=4ÞÓÑ[© Tƒ=d ‹[Ê ÃwVü ÷Íÿý …€……àû ú Û0 ¢ SMTP:SPAARENADVIES@VIRUSFREE.BEspaarenadvies@virusfree.beSMTPspaarenadvies@virusfree.be+¤¾£nÝTspaarenadvies@virusfree.beSMTPspaarenadvies@virusfree.be ÿSÝ000 0 ÝöÞ0 X-UIDLX-RCPT-TO*Internet Charset Body*X-OriginalArrivalTime X-Originating-IPX-Sender&X-Originating-Email…€……  ( þÿÿÿþÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿX ˆ ¬ À  ÀF ÀF†ÀF€v:Nz·Ð¥ÀOÖV…
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
What you posted is a fragment of a Word document.  Are your messages in Rich-text format?  Yes, we can change the way folders are named, but I wouldn't recommend using the sender's name, assuming that what you mean when you said "the name of the shipper".  The problem with that is that the names of the messages will then have to be unique, and we'll need to create uniquely named sub-folders to hold the attachments.  That's because we'd need to separate the attachments both to know which message they go with and to avoid overwriting like named items.  
0
 

Author Comment

by:1pc
Comment Utility
How can i see if a message is in rich-text format?
I have tried to send you a message by email but the orignal message is message.htm and when i want to sent it to you as an attachement my outlook converts the name of the message to "contact sonja.msg" and that opens correct.
I mean "the sender's name"
I'm from Belgium, speaking dutch, and my english is not very well, sorry.

Greetings

Stefaan
1pc
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Stefaan,

No apology needed.  Your English is far better than my Dutch.  Never mind checking to see if the message is in rich-text format.  I looked at the code I posted and realized I made a mistake on the command to save the message.  Change this line of code

    olkItem.SaveAs objTemp.Path & "\Message.htm"

to

    olkItem.SaveAs objTemp.Path & "\Message.htm", olHTML


0
 

Author Comment

by:1pc
Comment Utility
David,

This line is not correct.
I get a fault and when i search for the fault he stops at the new line.

I paste the code here so you can see if I made a mistake

Greetings

Stefaan
1pc


Sub ExportFolderToFileSystem()
    Dim olkFolder As Object, _
        olkItems As Object, _
        olkItem As Object, _
        olkAttachment As Object, _
        objFSO As Object, _
        objFSFolder As Object, _
        objTemp As Object, _
        strFolder As String
    Set olkFolder = Application.ActiveExplorer.CurrentFolder
    Set olkItems = olkFolder.Items
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the starting folder on the following line as desired
    strFolder = GetFolderName("d:\emailexport1")
    Set objFSFolder = objFSO.GetFolder(strFolder)
    For Each olkItem In olkItems
        Set objTemp = objFSFolder.SubFolders.Add("MSG" & StrZero(objFSFolder.SubFolders.Count + 1, 6))
        olkItem.SaveAs objTemp.Path & "\Message.htm", olHTML
        For Each olkAttachment In olkItem.Attachments
            olkAttachment.SaveAsFile objTemp.Path & "\" & olkAttachment.FileName
        Next
    Next
    Set objTemp = Nothing
    Set objFSFolder = Nothing
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkItem = Nothing
    Set olkItems = Nothing
    Set olkFolder = Nothing
    MsgBox "All done!"
End Sub

Function GetFolderName(strStartingFolder As Variant) As String
    Const WINDOW_HANDLE = 0
    Const NO_OPTIONS = 0
    Dim objShell As Object, _
        objFolder As Object, _
        objFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, strStartingFolder)
    If Not TypeName(objFolder) = "Nothing" Then
        Set objFolderItem = objFolder.self
        GetFolderName = objFolderItem.Path & "\"
    Else
        GetFolderName = ""
    End If
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Function

Function StrZero(varNumber As Variant, intLength As Integer) As String
    Dim intItemLength As Integer, _
        intDifference As Integer
    If IsNumeric(varNumber) Then
        intItemLength = Len(CStr(Int(varNumber)))
        If intItemLength < intLength Then
            intDifference = intLength - intItemLength
            StrZero = String(intDifference, "0") & varNumber
        Else
            StrZero = varNumber
        End If
    Else
        StrZero = varNumber
    End If
End Function


0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
Good morning, Stefaan.

Replace the code you have with the version below.  I added code to make the save process more intelligent.  It also fixed the problem you ran into.

Sub ExportFolderToFileSystem()
    Dim olkFolder As Object, _
        olkItems As Object, _
        olkItem As Outlook.MailItem, _
        olkAttachment As Object, _
        objFSO As Object, _
        objFSFolder As Object, _
        objTemp As Object, _
        strFolder As String, _
        strFileName As String
    Set olkFolder = Application.ActiveExplorer.CurrentFolder
    Set olkItems = olkFolder.Items
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the starting folder on the following line as desired
    strFolder = GetFolderName("d:\emailexport1")
    Set objFSFolder = objFSO.GetFolder(strFolder)
    For Each olkItem In olkItems
        Set objTemp = objFSFolder.SubFolders.Add("MSG" & StrZero(objFSFolder.SubFolders.Count + 1, 6))
        strFileName = objTemp.Path & "\Message." & GetExtension(olkItem.BodyFormat)
        If objFSO.FolderExists(objTemp.Path) Then
            olkItem.SaveAs strFileName, GetMsgFormat(olkItem.BodyFormat)
            For Each olkAttachment In olkItem.Attachments
                olkAttachment.SaveAsFile objTemp.Path & "\" & olkAttachment.FileName
            Next
        Else
            MsgBox "Cannot find the folder just created.", vbCritical, "Error Exporting Message"
        End If
    Next
    Set objTemp = Nothing
    Set objFSFolder = Nothing
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkItem = Nothing
    Set olkItems = Nothing
    Set olkFolder = Nothing
    MsgBox "All done!"
End Sub

Function GetFolderName(strStartingFolder As Variant) As String
    Const WINDOW_HANDLE = 0
    Const NO_OPTIONS = 0
    Dim objShell As Object, _
        objFolder As Object, _
        objFolderItem As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "Select a folder:", NO_OPTIONS, strStartingFolder)
    If Not TypeName(objFolder) = "Nothing" Then
        Set objFolderItem = objFolder.self
        GetFolderName = objFolderItem.Path & "\"
    Else
        GetFolderName = ""
    End If
    Set objFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
End Function

Function StrZero(varNumber As Variant, intLength As Integer) As String
    Dim intItemLength As Integer, _
        intDifference As Integer
    If IsNumeric(varNumber) Then
        intItemLength = Len(CStr(Int(varNumber)))
        If intItemLength < intLength Then
            intDifference = intLength - intItemLength
            StrZero = String(intDifference, "0") & varNumber
        Else
            StrZero = varNumber
        End If
    Else
        StrZero = varNumber
    End If
End Function

Function GetMsgFormat(intFormat As Integer) As Integer
    Select Case intFormat
        Case olFormatHTML
            GetMsgFormat = olHTML
        Case olFormatPlain
            GetMsgFormat = olTXT
        Case olFormatRichText
            GetMsgFormat = olRTF
        Case olFormatUnspecified
            GetMsgFormat = olTXT
    End Select
End Function

Function GetExtension(intFormat As Integer) As String
    Select Case intFormat
        Case olFormatHTML
            GetExtension = "htm"
        Case olFormatPlain
            GetExtension = "txt"
        Case olFormatRichText
            GetExtension = "rtf"
        Case olFormatUnspecified
            GetExtension = "txt"
    End Select
End Function

0
 

Author Comment

by:1pc
Comment Utility
Hi David,

This works fine.
If you now could change the foldernames (MSG00000x) to a unique other name in that way that i can recognise the email.
For example: name of the sender and time/date or name of the sender and subjet and time/date
The second option is the best for me.
I hope you can realise this. If you can, i'm very happy because that is what i am searching for.

Greetings

Stefaan
1pc
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
Comment Utility
Ok, I made the change.  The folder name will be the sender name and the date/time the message arrived.  Replace the subroutine named ExportFolderToFileSystem with the one below.

Sub ExportFolderToFileSystem()
    Dim olkFolder As Object, _
        olkItems As Object, _
        olkItem As Outlook.MailItem, _
        olkAttachment As Object, _
        objFSO As Object, _
        objFSFolder As Object, _
        objTemp As Object, _
        strFolder As String, _
        strFileName As String
    Set olkFolder = Application.ActiveExplorer.CurrentFolder
    Set olkItems = olkFolder.Items
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Change the starting folder on the following line as desired
    strFolder = GetFolderName("d:\emailexport1")
    Set objFSFolder = objFSO.GetFolder(strFolder)
    For Each olkItem In olkItems
        'Set objTemp = objFSFolder.SubFolders.Add("MSG" & StrZero(objFSFolder.SubFolders.Count + 1, 6))
        Set objTemp = objFSFolder.SubFolders.Add(olkItem.SenderName & " " & Format(olkItem.ReceivedTime, "yyyy-mm-dd hhmmss AMPM"))
        strFileName = objTemp.Path & "\Message." & GetExtension(olkItem.BodyFormat)
        If objFSO.FolderExists(objTemp.Path) Then
            olkItem.SaveAs strFileName, GetMsgFormat(olkItem.BodyFormat)
            For Each olkAttachment In olkItem.Attachments
                olkAttachment.SaveAsFile objTemp.Path & "\" & olkAttachment.FileName
            Next
        Else
            MsgBox "Cannot find the folder just created.", vbCritical, "Error Exporting Message"
        End If
    Next
    Set objTemp = Nothing
    Set objFSFolder = Nothing
    Set objFSO = Nothing
    Set olkAttachment = Nothing
    Set olkItem = Nothing
    Set olkItems = Nothing
    Set olkFolder = Nothing
    MsgBox "All done!"
End Sub
0
 

Author Comment

by:1pc
Comment Utility
David,

Thank you very much.
This is what i was searching for.

Greetings

Stefaan
1pc
0
 
LVL 76

Expert Comment

by:David Lee
Comment Utility
You are welcome, Stefaan.  Happy I could help.
0

Featured Post

Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

Join & Write a Comment

Resolve Outlook connectivity issues after moving mailbox to new Exchange 2016 server
Follow this checklist to learn more about the 15 things you should never include in an email signature from personal quotes, animated gifs and out-of-date marketing content.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …
To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now