Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

How to save email on a dvd

Posted on 2006-07-18
20
Medium Priority
?
982 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 9
  • 8
  • 2
  • +1
20 Comments
 
LVL 20

Expert Comment

by:Dufo G. Belski
ID: 17132912
0
 

Author Comment

by:1pc
ID: 17132988
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
ID: 17132992
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
NFR key for Veeam Backup for Microsoft Office 365

Veeam is happy to provide a free NFR license (for 1 year, up to 10 users). This license allows for the non‑production use of Veeam Backup for Microsoft Office 365 in your home lab without any feature limitations.

 
LVL 20

Expert Comment

by:Dufo G. Belski
ID: 17133053
Exactly.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17133289
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
ID: 17133324
Hi BlueDevilFan,

Can i than export all the messages at once?

Greetings
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17133841
1pc,

Absolutely.
0
 

Author Comment

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

0
 

Author Comment

by:1pc
ID: 17134137
I prefer HTML-format

Greetings

Stefaan

1pc
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17135466
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
 

Author Comment

by:1pc
ID: 17136096
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
ID: 17136774
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
ID: 17137705
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
ID: 17139492
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
ID: 17143827
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
ID: 17144805
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
ID: 17145060
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 2000 total points
ID: 17148293
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
ID: 17149750
David,

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

Greetings

Stefaan
1pc
0
 
LVL 76

Expert Comment

by:David Lee
ID: 17149767
You are welcome, Stefaan.  Happy I could help.
0

Featured Post

Learn Veeam advantages over legacy backup

Every day, more and more legacy backup customers switch to Veeam. Technologies designed for the client-server era cannot restore any IT service running in the hybrid cloud within seconds. Learn top Veeam advantages over legacy backup and get Veeam for the price of your renewal

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will help to fix the below errors for MS Exchange Server 2013 I. Certificate error "name on the security certificate is invalid or does not match the name of the site" II. Out of Office not working III. Make Internal URLs and Externa…
The core idea of this article is to make you acquainted with the best way in which you can export Exchange mailbox to PST format.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.

604 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