How to save email on a dvd

Good luck.  Check out this:  https://www.experts-exchange.com/questions/21710207/Need-Free-Outlook-PST-email-viewer.html

This doesn't help me. It requires outlook to be installed on the computer.
I want to view the emails without outlook installed.

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!

Exactly.

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!

Hi BlueDevilFan,

Can i than export all the messages at once?

Greetings

1pc,

Absolutely.

Ok i will try this but you have to explain it very well because i know nothing about scripts.

I prefer HTML-format

Greetings

Stefaan

1pc

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

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/45233515700000006
spaaradvies@virusfree.bespaarenadvies+b20060709083337452335157é°ª9áÄÔMŽ)¢‹€1i
LZFu 8, rcpg125â2CtexA

÷ÿ €¤ä€óPV?U²%Q
chá À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 00000006
spaaradvies@virusfree.be
spaarenadvies00000006
spaaradvies@virusfree.be
spaarenadviesevelinebovenkerk@hotmail.comSMTPSMTP:EVELINEBOVENKERK@HOTMAIL.COMEveline Bovenkerk+¤¾£nÝ
T
Eveline 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Ý
T
Eveline 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ÝB
CDÞD
QÝ
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Ý
T
spaarenadvies@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…

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.  

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

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

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

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

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

David,

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

Greetings

Stefaan
1pc

You are welcome, Stefaan.  Happy I could help.