Considerazioni fuori programma (rispetto alle macro e all'IT)

Sperando di non disturbare la suscettibilità o la commiserazione di chicchessia, mi permetto alcune osservazioni spicciole su tre celebri antinomie (senza pretesa di essere esaustivo né di aver fatto scoperte originali o peggio di non commettere errori).

Premetto che i vari casi mi paiono afflitti da un limite della logica, almeno “normale” (ossia degli Enunciati) quando pretende di considerare il tempo...

ACHILLE E LA TARTARUGA

Considerare unità di tempo piccole a piacere è legittimo, ma non lo è aggiungerne di sempre più piccole concludendo con MAI. Infatti nel primo caso, per quanto piccoli siano gl’intervalli temporali Achille supererà di certo la tartaruga in un numero finito di essi.

IL CRETESE

Non è possibile, per coerenza, che un perfetto mentitore dica “tutto quel che dico è falso”, potrà semmai affermare “tutto quel che dico è vero”. Dopo di che, sospettato ingiustamente di un  delitto capitale risponderà sì alla domanda “Sei tu il colpevole?”, senza la soddisfazione di poter affermare, sul patibolo, “Muoio per amore della Menzogna!”. [O forse “Muoio per amore della verità” è un’antinomia? Boh].

IL BARBIERE

L’editto “Il barbiere deve radere tutti quelli che non si fanno la barba da soli” presenta almeno un’ambiguità: è lecito farsi radere da un altro? Immaginiamo che alla specifica richiesta di chiarimento – come sempre accade nelle norme giuridiche o assimilabili che richiedono interpretazioni “autentiche” sullo spirito di una legge – il Sovrano cambi la dizione in “Tutti gli abitanti si debbono radere da soli o farsi radere dal barbiere”, che, senza chiarire esplicitamente che cosa deve fare il barbiere,  esclude la possibilità di ricorrere ad altri che non sia il barbiere. A parte il fatto che resta oscura e comunque ardua la possibilità di sanzione, esclusa la fragranza (ma se uno è sbarbato che si fa?), e tralasciando l’ipotesi di un barbiere eunuco o femmina, il punto a mio avviso è che il barbiere ha un duplice ruolo: cittadino e funzionario-barbitonsore (senza essere schizofrenico: tutti hanno ruoli molteplici in un consesso sociale). E scegliendo di radersi da solo, come cittadino, subito DOPO toglie a se stesso, cioè al barbiere, il compito di farlo.

CIRCUITI LOGICI SEQUENZIALI

Mi permetto di insistere coi Logici puri (che finora non mi hanno dato retta...). I circuiti logici sequenziali (elettronici o, persino, implementati con relè e contatti) hanno un comportamento che varia nel tempo, presentando cioè una isteresi appunto temporale. Ne sono esempi noti anche a chi ne ignora le connessioni (di tipo feedback) i circuiti memoria (come i flip-flop) o gli oscillatori. I tecnici per descriverli e progettarli adottano una particolare – ma semplice nei casi elementari - Algebra booleana, in cui sono in gioco NEGAZIONI delle uscite riportate in input. Ad esempio con un X  = not Y ove X e Y sono, rispettivamente l’input e l’output si ottiene sulla carta ma anche di fatto un oscillatore di periodo pari al tempo che separa Y e X.

Dunque “in natura” le antinomie sono di fatto risolte. O no?

Buon 2010 !

P.S. – Aggiungo che l’astrattezza della logica rispetto alla lebenswelt (mondo della vita) si fa sentire anche in altri contesti ove siano in gioco verbi riflessivi. Provare per ridere, con “sputarsi” o, peggio, con “masturbarsi”. O, in genere, con verbi che ammettono solo forma riflessiva...

Ricerca filtrata di mail: richiesta a chi-sa-parli

Un certo Lorenzo Pedrinolli mi ha sottoposto un problema, al quale onestamente non trovo soluzione per mancanza di tempo (o incompetenza? Ebbene sì...). Tuttavia ritengo che la cosa sia di grande interesse per molti, me incluso, tanto più che il buon Lorenzo fornisce pure una complessa routine attinta dal Web, che ahimè sul suo PC malfunziona, ma fusse che fusse che un erroraccio banale è alla base del dramma?

Che fare? Pensa e ripensa ho creduto utile pubblicare la richiesta del sullodato Pedrinolli, nella speranza che qualche anima buona ed esperta sappia aiutarlo. In tal caso siete pregati di rivolgersi al sottoscritto solo in caso di soluzioni valide, altrimenti indirizzate soltanto al sullodato:

lorenzo.pedrinolli@gmail.com

Salve Gianni,

Il mio datore di lavoro, per mia disgrazia, mi ha promosso programmatore solo perché me la cavo con Visual Basic e SQL. Sono incappato nel suo sito alla disperata ricerca di una soluzione per esportare le mail da Outlook con una procedura quanto più automatica possibile e, facendole i complimenti [non c’è di che – G.G. ], ho trovato tutto quello che mi serviva. Ora però è nato il problema opposto: da 50 - 100 mail che dovevano essere archiviate siamo passati a 4 - 5000 in poco più di due mesi e, ovviamente, mi è stato chiesto un programma per ricercarle in base ad attributi vari: corpo, destinatario, mittente ecc.

Ora non sono in grado di trovare un modo per leggere le proprietà di un file *.msg presente sul disco ne tantomeno di far riconoscere a vb che quel file è un messaggio.

L'unica soluzione che ho trovato è una script (che riporto qui sotto). A detta dell'autore dovrebbe leggere queste proprietà senza far ricorso ad oggetti esterni... peccato che non riconosca i file msg presenti sul mio pc e che vada in ciclo senza fine una volta sì e l'altra pure.

Confidando che riesca a trovare 10 minuti per aiutarmi [altro che dieci minuti! Ce ne vorrebbero molti di più! Io non li ho ma qualcun altro ? G.G.] le porgo saluti e rinnovati ringraziamenti  per avermi salvato in varie occasioni.

La routine deludente

Viene qui sotto riportata senza altri commenti se non quelli incorporate [e sperando che gli esperti cui si rivolge la richiesta di aiuto se la cavino in tale guazzabuglio. G.G. ]

Option Explicit On
Module Prova


    'MsgBox MsgGet("DateSent,ReplyType,DateReply,RecipientsBCC,RecipientsTo,RecipientsCC,From,Prefix,MessageID,Subject,DateSent,DateReceived,AttachmentNumbers,AttachmentExtract,AttachmentNames,Recipients","temp.MSG")


    Function MsgGet(ByVal s_Val, ByVal s_fileName)

        ' **********************************************************************************
        '                            Outlook MSG Reading Utility
        '                                Sean Currie @2005
        '
        ' Description : Decodes an Outlook MSG file by reading the Compound Binary File
        '               format directly. Note most of the details on the compound binary
        '               file format derived from www.openoffice.org
        '               It DOES NOT require Outlook to be installed on the client machine
        '               nor does it require access to any libraries or third party DLL's
        ' Arguments   : The value or values to return (each separated by a comma)
        '                       e.g.
        '                       Subject            - The subject of the email
        '                       Prefix          - The subject prefix of the email
        '                       MessageID               - The Message ID
        '                       From             - The from address or name whichever
        '                                                 available
        '                       Body                    - The Message Body
        '                       AttachmentNumbers    - The number of attachments
        '                       AttachmentNames        - The names of the attachments
        '                                                 (multiple values separated by a |)
        '                       Recipients        - All of the recipient addresses or name whichever
        '                                                 available (multiple values
        '                                                 separated by a |)
        '                                                 includes TO, CC and BCC
        '                       RecipientsTo        - All the TO addresses or name whichever
        '                                                 available (multiple values
        '                                                 separated by a |)
        '                       RecipientsCC        - All the CC addresses or name whichever
        '                                                 available (multiple values
        '                                                 separated by a |)
        '                       RecipientsBCC        - All the BCC addresses or name whichever
        '                                                 available (multiple values
        '                                                 separated by a |)
        '                       AttachmentExtract    - The attachments are extracted to
        '                                                 a temporary folder and the names
        '                                                 returned to the user
        '                                                 (multiple values spearated by a |)
        '                       DateSent                - The date sent of the email (may not
        '                                                 have been sent if in drafts)
        '                       DateReceived            - The date received if the email has
        '                                                 been received
        '                       DateReply               - Date reply requested in follow up
        '                       ReplyType               - Reply type (Follow up type)
        '                      
        '                       Each value is separated by a ^ and each sub value by a |
        '                       For example:
        '                         asking for Recipients could return
        '                         sean.currie@poboxes.com|nuala.currie@poboxes.com
        '                         You could then use Split to create an array
        '                       For example:
        '                         asking for "Recipients,From" could return
        '                         sean.currie@poboxes.com|nuala.currie@poboxes.com^anyone@internet.com
        '                         You could then use Split with ^ to create two arrays
        '                         One of recipients and one of froms
        '                         Then you could use Split again to get a list of the Recipients
        '
        'Examples     : Extract just the subject
        '               MsgBox MsgGet("Subject","test.msg")
        '
        '               Extract multiple fields there we extract the Subject and the From address
        '               MsgBox MsgGet("Subject,From","test2.msg")
        '
        '               Extract the subject, extract the attachments to the temporary folder and
        '               return the names of the attachments
        '               MsgBox MsgGet("Subject,AttachmentExtract","shortcut.msg")
        '
        ' Created     : 24/12/2005
        ' Version     : 1.0
        '
        ' Description : Modified the way attachments are decoded using a new feature I call
        '               the MultiSectorReader, this speeds up sector decoding by reading
        '               sequential sectors in one go thereby speeding up the read process for
        '               big emails
        ' Modified    : 02/01/2006
        ' Version     : 1.1
        '
        ' Description : Found failure when number of bytes to read for a sector was zero added
        '               code to check for zero sectors
        ' Modified    : 28/01/2007
        ' Version     : 1.2
        '
        ' Description : Major rewrite to reflect use of OutlookSpy to determine ID's of fields
        '               Now accurately reports submit time and received time (previously searched
        '               headers, now uses proper MAPI properties to get them).
        '               Now also report recipients more accurately and can now separate TO, CC and
        '               BCC.
        '               Removed receivedby as didn't think it would ever be used.
        '               Added support to determine follow up date of email (reply by field)
        '               Now also correctly builds the directory from the array
        ' Modified    : 23/02/2007
        ' Version     : 2.0
        ' **********************************************************************************

        Dim o_FSO               ' File system object
        Dim o_File               ' The input MSG file
        Dim s_String           ' Temporary string
        Dim s_Temp               ' Temporary variable
        Dim s_SectSize           ' Sector size
        Dim s_ShortSectSize       ' Short sector size
        Dim s_SectSAT           ' No of SAT sectors
        Dim s_DIRSID           ' First SID of directory
        Dim s_MinStream           ' Minimum size of standard stream
        Dim s_SIDSSAT           ' SID of the SSAT
        Dim s_SSATNumber       ' Number of SSAT sectors
        Dim s_SAT               ' The array of SAT entries
        Dim s_MSATSID           ' First sector of MSAT
        Dim s_SectMSAT           ' No of MSAT sectors
        Dim a_Temp(0, 0)        ' The array of temporary entries
        Dim a_Dir(0, 0)                ' The array of directory entries
        Dim a_MSAT()           ' The array of MSAT entries
        Dim a_SSAT()           ' The array of SSAT entries
        Dim M_W                   ' Temporary Counter
        Dim M_X                   ' Temporary Counter
        Dim M_Y                   ' Temporary Counter
        Dim M_Z                   ' Temporary Counter
        Dim s_ShortSat           ' The short sector container stream
        Dim s_ShortStart       ' The short sector SAT data
        Dim s_ShortSize           ' The short sector SAT data
        Dim a_Val               ' Array of s_Val awaiting return values
        Dim b_Debug               ' Set this variable to True to create TXT files in the
        ' current directory to see what is being read from the
        ' MSG file
        Dim s_Return           ' The returned string
        Dim s_MessageID           ' The message ID
        Dim s_Subject           ' The message subject
        Dim s_From               ' The message from address
        Dim s_Prefix           ' The message subject prefix
        Dim s_Body               ' The message body
        Dim s_AttachNums       ' The message attachment numbers
        Dim a_AttachNames()       ' The message attachment names
        Dim a_Recipients()       ' The message recipients (To, CC and BCC)
        Dim a_RecipientsTo()   ' The message recipients in the TO list
        Dim a_RecipientsCC()   ' The message recipients in the CC list
        Dim a_RecipientsBCC()  ' The message recipients in the BCC list
        Dim a_Attachments()       ' The message attachments names on disk
        Dim a_Attachments2()   ' The message attachments names
        Dim s_DateSent           ' The message date was sent
        Dim s_DateReceived       ' The message date was received
        Dim s_DateReply           ' The message date of reply (also known as follow up date)
        Dim s_ReplyType           ' The message follow up type

        ' Create object and get the file
        o_FSO = My.Computer.FileSystem

        If Not o_FSO.FileExists(s_fileName) Then
            MsgGet = "Error: File does not exist!"
            Exit Function
        End If
        If UCase(Right(s_fileName, 4)) <> ".MSG" Then
            MsgGet = "Error: Not an MSG file!"
            Exit Function
        End If

        o_File = My.Computer.FileSystem.ReadAllText(s_fileName)

        ' Check that right hand of s_Val has comma
        If Right(s_Val, 1) <> "," Then
            s_Val = s_Val & ","
        End If
        s_Val = UCase(s_Val)

        ' Set the return variables to nothing
        MsgGet = ""
        s_ShortSat = ""
        s_Return = ""
        s_Subject = ""
        s_MessageID = ""
        s_From = ""
        s_Prefix = ""
        s_Body = ""
        s_AttachNums = 0
        b_Debug = True
        s_DateSent = ""
        s_DateReceived = ""
        s_DateReply = ""
        s_ReplyType = ""

        ' Read header characters
        s_String = o_File.Read(8)

        ' Check its a compound file
        If s_String <> MyHexToHexCoded("D0CF11E0A1B11AE1") Then
            MsgGet = "Error: Not an MSG file!"
            Exit Function
        End If

        ' Read 16 chars unique identifier with revision
        s_String = o_File.Read(20)

        ' Read 2 chars of byte identifier
        s_String = o_File.Read(2)

        If s_String <> MyHexToHexCoded("FEFF") Then
            MsgGet = "Error: Not an MSG file!"
            Exit Function
        End If

        ' Read 2 chars of sector size
        s_String = o_File.Read(2)

        ' Convert to number and power of 2
        s_SectSize = 2 ^ MyVBNumber(s_String)

        ' Read 2 chars of short sector size
        s_String = o_File.Read(2)

        ' Convert to number and power of 2
        s_ShortSectSize = 2 ^ MyVBNumber(s_String)

        ' Read 10 chars of invalid data
        s_String = o_File.Read(10)

        ' Read 4 chars of sectors in SAT
        s_String = o_File.Read(4)

        ' Convert to number
        s_SectSAT = MyVBNumber(s_String)

        ' Read 4 chars of first DIR SID
        s_String = o_File.Read(4)

        ' Convert to number
        s_DIRSID = MyVBNumber(s_String)

        ' Read 4 chars of invalid data
        s_String = o_File.Read(4)

        ' Read 4 chars of min stream size
        s_String = o_File.Read(4)

        ' Convert to number
        s_MinStream = MyVBNumber(s_String)

        ' Read 4 chars of SID of the SSAT
        s_String = o_File.Read(4)

        ' Convert to number
        s_SIDSSAT = MyVBNumber(s_String)

        ' Read 4 chars of number of SSAT sectors
        s_String = o_File.Read(4)

        ' Convert to number
        s_SSATNumber = MyVBNumber(s_String)

        ' Read 4 chars of MSAT SID
        s_String = o_File.Read(4)

        ' Convert to number
        s_MSATSID = MyVBNumber(s_String)

        ' Read 4 chars of number of sectors in MSAT
        s_String = o_File.Read(4)

        ' Convert to number
        s_SectMSAT = MyVBNumber(s_String)

        ' Now read the first 109 entries in the MSAT
        For M_X = 1 To 109

            ' Read 4 chars of MSAT sector IDs
            s_String = o_File.Read(4)

            If MyVBNumber(s_String) >= 0 Then

                ReDim Preserve a_MSAT(MyArrayLen(a_MSAT, 1) + 1)

                a_MSAT(MyArrayLen(a_MSAT, 1) - 1) = MyVBNumber(s_String)

            End If

        Next

        o_File.Close()

        ' The header has now been read
        ' We now know quite a few things
        ' - The total number of sectors in the MSAT
        ' - The first sector of the MSAT to start reading it
        ' We can now read the MSAT and from there we can read everything

        ' Do we need to read the MSAT if it is more than 109 entries?
        If s_MSATSID <> -2 Then

            M_Y = s_MSATSID

            ' Lets loop through the MSAT
            Do While M_Y >= 0

                s_Temp = MySectorReader(s_SectSize, M_Y, s_fileName)

                For M_X = 1 To s_SectSize - 4 Step 4

                    s_String = Mid(s_Temp, M_X, 4)

                    If MyVBNumber(s_String) > 0 Then

                        ReDim Preserve a_MSAT(MyArrayLen(a_MSAT, 1) + 1)

                        a_MSAT(MyArrayLen(a_MSAT, 1) - 1) = MyVBNumber(s_String)

                    End If
                Next

                s_String = Right(s_Temp, 4)
                If MyVBNumber(s_String) > 0 Then
                    M_Y = MyVBNumber(s_String)
                Else
                    M_Y = -2
                End If

            Loop
        End If

        ' Temporary debug routine to write out the MSAT
        If b_Debug Then
            o_File = o_FSO.CreateTextFile("MSAT.TXT")
            For M_X = 0 To MyArrayLen(a_MSAT, 1) - 1
                o_File.WriteLine("---" & a_MSAT(M_X))
            Next
            o_File.Close()
        End If

        ' We now have the MSAT hence we can now build the SAT from this
        s_SAT = ""

        For M_Y = 0 To (MyArrayLen(a_MSAT, 1) - 1)

            s_SAT = s_SAT & MySectorReader(s_SectSize, a_MSAT(M_Y), s_fileName)

        Next

        ' Temporary debug routine to write out the SAT
        If b_Debug Then
            o_File = o_FSO.CreateTextFile("SAT.TXT")
            o_File.WriteLine("Sector" & Chr(9) & " : " & "Value")
            For M_X = 1 To Len(s_SAT) Step 4
                o_File.WriteLine(Int(M_X / 4) & Chr(9) & " : " & MyVBNumber(Mid(s_SAT, M_X, 4)))
            Next
            o_File.Close()
        End If

        ' Now we can read the Short Sector SSAT
        If s_SIDSSAT <> -2 Then

            M_Y = s_SIDSSAT
            s_Temp = MySectorReader(s_SectSize, M_Y, s_fileName)

            For M_X = 1 To s_SectSize Step 4

                s_String = Mid(s_Temp, M_X, 4)

                ReDim Preserve a_SSAT(MyArrayLen(a_SSAT, 1) + 1)
                a_SSAT(MyArrayLen(a_SSAT, 1) - 1) = MyVBNumber(s_String)

            Next

            M_Z = 1
            Do While True
                M_Y = MyVBNumber(Mid(s_SAT, (M_Y * 4) + 1, 4))
                If M_Y > 0 Then
                    M_Z = M_Z + 1
                    s_Temp = MySectorReader(s_SectSize, M_Y, s_fileName)
                    For M_X = 1 To s_SectSize Step 4
                        s_String = Mid(s_Temp, M_X, 4)

                        ReDim Preserve a_SSAT(MyArrayLen(a_SSAT, 1) + 1)

                        a_SSAT(MyArrayLen(a_SSAT, 1) - 1) = MyVBNumber(s_String)
                    Next
                End If
                If M_Z = s_SSATNumber Then
                    Exit Do
                End If
            Loop

        End If

        ' Temporary debug routine to write out the SSAT
        If b_Debug Then
            o_File = o_FSO.CreateTextFile("SSAT.TXT")
            For M_X = 0 To MyArrayLen(a_SSAT, 1) - 1
                o_File.WriteLine(M_X & Chr(9) & " : " & a_SSAT(M_X))
            Next
            o_File.Close()
        End If

        ' Finally lets read the directory
        M_Y = s_DIRSID

        ' Lets loop through the DIRECTORY
        M_Z = -1
        Do While M_Y >= 0

            s_Temp = MySectorReader(s_SectSize, M_Y, s_fileName)


            For M_X = 1 To s_SectSize Step 128

                M_Z = M_Z + 1

                ' First lets check the type of the directory entry and if zero it is unused
                If MyVBNumber(Mid(s_Temp, M_X + 66, 1)) <> 0 Then


                    If MyArrayLen(a_Dir, 2) = 0 Then
                        ReDim Preserve a_Dir(8, 1)
                    Else
                        ReDim Preserve a_Dir(8, MyArrayLen(a_Dir, 2) + 1)
                    End If

                    ' Format of the array
                    ' 0 - DID
                    ' 1 - Name
                    ' 2 - Type
                    ' 3 - DID Left Child
                    ' 4 - DID Right Child
                    ' 5 - DID root node
                    ' 6 - SID of first sector
                    ' 7 - Stream size

                    a_Dir(0, MyArrayLen(a_Dir, 2) - 1) = M_Z
                    a_Dir(1, MyArrayLen(a_Dir, 2) - 1) = Replace(Mid(s_Temp, M_X, MyVBNumber(Mid(s_Temp, M_X + 64, 2))), Chr(0), "")
                    a_Dir(2, MyArrayLen(a_Dir, 2) - 1) = MyVBNumber(Mid(s_Temp, M_X + 66, 1))
                    a_Dir(3, MyArrayLen(a_Dir, 2) - 1) = MyVBNumber(Mid(s_Temp, M_X + 68, 4))
                    a_Dir(4, MyArrayLen(a_Dir, 2) - 1) = MyVBNumber(Mid(s_Temp, M_X + 72, 4))
                    a_Dir(5, MyArrayLen(a_Dir, 2) - 1) = MyVBNumber(Mid(s_Temp, M_X + 76, 4))
                    a_Dir(6, MyArrayLen(a_Dir, 2) - 1) = MyVBNumber(Mid(s_Temp, M_X + 116, 4))
                    a_Dir(7, MyArrayLen(a_Dir, 2) - 1) = MyVBNumber(Mid(s_Temp, M_X + 120, 4))

                End If

            Next

            M_Y = MyVBNumber(Mid(s_SAT, (M_Y * 4) + 1, 4))

        Loop

        ' Temporary debug routine to write out the SSAT
        ' TO BE REMOVED
        'If b_Debug Then
        '    o_File = o_FSO.CreateTextFile("DIR.TXT")
        '    o_File.WriteLine("DID" & Chr(9) & " : " & "Name" & String(30 - Len("Name"), " ") & " : " & "Type" & Chr(9) & " : " & "Left DID" & Chr(9) & " : " & "Right DID" & Chr(9) & " : " & "Root DID" & Chr(9) & " : " & "Start Sec" & Chr(9) & " : " & "Size")
        '    For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
        '  o_File.WriteLine(a_DIR(0,M_X) & Chr(9) & " : " & a_DIR(1,M_X) & String(30-Len(a_DIR(1,M_X))," ") & " : " & a_DIR(2,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(3,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(4,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(5,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(6,M_X) & Chr(9) & Chr(9) & " : " & a_DIR(7,M_X))
        '    Next
        '    o_File.Close()
        'End If

        ' Find out the starting SID for the short stream container and then read the short stream container
        If s_SIDSSAT <> -2 Then

            s_ShortStart = 0
            s_ShortSize = 0
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                If InStr(UCase(a_Dir(1, M_X)), "ROOT ENTRY") > 0 Then

                    ' Allocate the first sector of the short sector container stream
                    s_ShortStart = a_Dir(6, M_X)
                    s_ShortSize = a_Dir(7, M_X)
                    Exit For
                End If

            Next

            M_Y = s_ShortStart
            s_ShortSat = MySectorReader(s_SectSize, M_Y, s_fileName)

            Do While True
                M_Y = MyVBNumber(Mid(s_SAT, (M_Y * 4) + 1, 4))
                If M_Y > 0 Then
                    s_ShortSat = s_ShortSat & MySectorReader(s_SectSize, M_Y, s_fileName)
                End If
                If Len(s_ShortSat) >= s_ShortSize Then
                    Exit Do
                End If
            Loop

        End If

        ' Now lets re-read the DIRECTORY in the proper order as Outlook scrambles it
        For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

            ' Check for a root entry
            If a_Dir(5, M_X) <> -1 Then

                ' Add to final array
                ReDim Preserve a_Temp(8, MyArrayLen(a_Temp, 2) + 1)
                a_Temp(0, MyArrayLen(a_Temp, 2) - 1) = a_Dir(0, M_X)
                a_Temp(1, MyArrayLen(a_Temp, 2) - 1) = a_Dir(1, M_X)
                a_Temp(2, MyArrayLen(a_Temp, 2) - 1) = a_Dir(2, M_X)
                a_Temp(3, MyArrayLen(a_Temp, 2) - 1) = a_Dir(3, M_X)
                a_Temp(4, MyArrayLen(a_Temp, 2) - 1) = a_Dir(4, M_X)
                a_Temp(5, MyArrayLen(a_Temp, 2) - 1) = a_Dir(5, M_X)
                a_Temp(6, MyArrayLen(a_Temp, 2) - 1) = a_Dir(6, M_X)
                a_Temp(7, MyArrayLen(a_Temp, 2) - 1) = a_Dir(7, M_X)

                MySubRead(a_Dir(5, M_X), -1, a_Dir, a_Temp)

            End If
        Next

        ' Temporary debug routine to write out the sorted DIRECTORY
        ' TO BE REMOVED
        'If b_Debug Then
        '    o_File = o_FSO.CreateTextFile("DIRFINAL.TXT")
        'o_File.WriteLine("DID" & Chr(9) & " : " & "Name" & String(30-Len("Name")," ") & " : " & "Type" & Chr(9) & " : " & "Left DID" & Chr(9) & " : " & "Right DID" & Chr(9) & " : " & "Root DID" & Chr(9) & " : " & "Start Sec" & Chr(9) & " : " & "Size")
        '    For M_X = 0 To MyArrayLen(a_Temp, 2) - 1
        '  o_File.WriteLine(a_Temp(0,M_X) & Chr(9) & " : " & a_Temp(1,M_X) & String(30-Len(a_Temp(1,M_X))," ") & " : " & a_Temp(2,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(3,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(4,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(5,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(6,M_X) & Chr(9) & Chr(9) & " : " & a_Temp(7,M_X))
        '    Next
        '    o_File.Close()
        'End If

        ReDim a_Dir(8, MyArrayLen(a_Temp, 2))

        For M_X = 0 To MyArrayLen(a_Temp, 2) - 1

            a_Dir(0, M_X) = a_Temp(0, M_X)
            a_Dir(1, M_X) = a_Temp(1, M_X)
            a_Dir(2, M_X) = a_Temp(2, M_X)
            a_Dir(3, M_X) = a_Temp(3, M_X)
            a_Dir(4, M_X) = a_Temp(4, M_X)
            a_Dir(5, M_X) = a_Temp(5, M_X)
            a_Dir(6, M_X) = a_Temp(6, M_X)
            a_Dir(7, M_X) = a_Temp(7, M_X)

        Next

        ' Now lets build the return strings and data
        If InStr(s_Val, "SUBJECT,") > 0 Then

            ' Now get the directory entry for the subject
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_0037") > 0 And a_Dir(7, M_X) > 0 Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_Subject = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_Subject = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If
                End If
            Next

        End If

        ' Now lets build the return strings and data
        If InStr(s_Val, "REPLYTYPE,") > 0 Then

            ' Now get the directory entry for the subject
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_8003") > 0 And a_Dir(7, M_X) > 0 Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_ReplyType = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_ReplyType = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If
                End If
            Next

        End If


        If InStr(s_Val, "MESSAGEID,") > 0 Then

            ' Now get the directory entry for the message id
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_1035") > 0 And a_Dir(7, M_X) > 0 Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_MessageID = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_MessageID = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If
                End If
            Next

        End If

        If InStr(s_Val, "FROM,") > 0 Then

            ' Now get the directory entry for the from type to find out the source email address
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for SMTP
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_0065") > 0 And a_Dir(7, M_X) > 0 And s_From = "" Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_From = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                    Else
                        s_From = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                    End If

                End If
            Next

            ' Check if valid SMTP address
            If InStr(s_From, "@") = 0 Then
                s_From = ""
            Else
                s_From = Replace(s_From, "<", "")
                s_From = Replace(s_From, ">", "")
                s_From = Replace(s_From, "'", "")
            End If

            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for return address
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_800A") > 0 And a_Dir(7, M_X) > 0 And s_From = "" Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_From = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_From = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If

                End If

            Next

            ' Check if valid SMTP address
            If InStr(s_From, "@") = 0 Then
                s_From = ""
            Else
                s_From = Replace(s_From, "<", "")
                s_From = Replace(s_From, ">", "")
                s_From = Replace(s_From, "'", "")
            End If

            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for return address
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_800B") > 0 And a_Dir(7, M_X) > 0 And s_From = "" Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_From = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_From = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If

                End If

            Next

            ' Check if valid SMTP address
            If InStr(s_From, "@") = 0 Then
                s_From = ""
            Else
                s_From = Replace(s_From, "<", "")
                s_From = Replace(s_From, ">", "")
                s_From = Replace(s_From, "'", "")
            End If

            ' Now get the directory entry for the from type to find out the source email address
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for display name
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_0C1A") > 0 And a_Dir(7, M_X) > 0 And s_From = "" Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_From = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_From = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If

                End If
            Next

        End If

        If InStr(s_Val, "PREFIX,") > 0 Then

            ' Now get the directory entry for the message id
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_003D") > 0 And a_Dir(7, M_X) > 0 Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_Prefix = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_Prefix = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If

                End If
            Next

        End If

        If InStr(s_Val, "BODY,") > 0 Then

            ' Now get the directory entry for the message body
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__SUBSTG1.0_1000") > 0 And a_Dir(7, M_X) > 0 Then

                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_Body = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat), Chr(0), "")
                        Exit For
                    Else
                        s_Body = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If
                End If
            Next

        End If

        If InStr(s_Val, "ATTACHMENTNUMBERS,") > 0 Then

            ' Now get the directory entry for the attachments
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                If InStr(UCase(a_Dir(1, M_X)), "__ATTACH_VERSION1.0_#") > 0 Then

                    ' Total the number in the email
                    s_AttachNums = s_AttachNums + 1

                End If
            Next

        End If

        If InStr(s_Val, "ATTACHMENTNAMES,") > 0 Then

            ' Now get the directory entry for the attachments
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for attachment
                If InStr(UCase(a_Dir(1, M_X)), "__ATTACH_VERSION1.0_#") > 0 Then

                    ReDim Preserve a_AttachNames(MyArrayLen(a_AttachNames, 1) + 1)

                    ' Get attachment name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for attachment name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        ElseIf InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3704") > 0 Then

                            ' Check if in short stream
                            If a_Dir(7, M_Y) < s_MinStream Then
                                a_AttachNames(MyArrayLen(a_AttachNames, 1) - 1) = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                a_AttachNames(MyArrayLen(a_AttachNames, 1) - 1) = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                        ElseIf InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3707") > 0 Then

                            ' Check if in short stream
                            If a_Dir(7, M_Y) < s_MinStream Then
                                a_AttachNames(MyArrayLen(a_AttachNames, 1) - 1) = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                a_AttachNames(MyArrayLen(a_AttachNames, 1) - 1) = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If
                        End If
                    Next
                End If
            Next

        End If

        If InStr(s_Val, "RECIPIENTS,") > 0 Then

            ' Now get the directory entry for the recipients
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for recipient
                If InStr(UCase(a_Dir(1, M_X)), "__RECIP_VERSION1.0_#") > 0 Then

                    ReDim Preserve a_Recipients(MyArrayLen(a_Recipients, 1) + 1)

                    s_Temp = ""

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for next recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then
                            Exit For
                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_39FE") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_Recipients(MyArrayLen(a_Recipients, 1) - 1) = s_String
                        End If
                    Next

                    ' Get org email
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for next recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For
                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_403E") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_Recipients(MyArrayLen(a_Recipients, 1) - 1) = s_String
                        End If
                    Next

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for next recipient display name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For
                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3001") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_Recipients(MyArrayLen(a_Recipients, 1) - 1) = s_String

                        End If
                    Next
                End If
            Next

        End If

        If InStr(s_Val, "RECIPIENTSTO,") > 0 Then

            ' Now get the directory entry for the recipients
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for recipient
                If InStr(UCase(a_Dir(1, M_X)), "__RECIP_VERSION1.0_#") > 0 Then

                    ReDim Preserve a_RecipientsTo(MyArrayLen(a_RecipientsTo, 1) + 1)

                    s_Temp = ""

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then
                            Exit For
                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_39FE") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsTo(MyArrayLen(a_RecipientsTo, 1) - 1) = s_String
                        End If
                    Next

                    ' Get org email
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient display name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_403E") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsTo(MyArrayLen(a_RecipientsTo, 1) - 1) = s_String

                        End If
                    Next

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient display name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3001") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsTo(MyArrayLen(a_RecipientsTo, 1) - 1) = s_String

                        End If
                    Next

                    ' Get recipient type and delete if wrong
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check if its in the TO list
                        If InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 And a_Dir(7, M_Y) > 0 Then

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat)
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            For M_Z = 1 To Len(s_String) Step 8
                                If Mid(s_String, M_Z, 4) = MyHexToHexCoded("0300150C") Then
                                    If MyVBNumber(Mid(s_String, M_Z + 8, 1)) <> 1 And s_Temp <> "" Then
                                        If MyArrayLen(a_RecipientsTo, 1) > 1 Then
                                            ReDim Preserve a_RecipientsTo(MyArrayLen(a_RecipientsTo, 1) - 1)
                                        Else
                                            ReDim a_RecipientsTo(0)
                                        End If
                                    End If
                                End If
                            Next

                        End If

                        ' Check for recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then
                            Exit For
                        End If
                    Next

                End If
            Next

        End If


        If InStr(s_Val, "RECIPIENTSCC,") > 0 Then

            ' Now get the directory entry for the recipients
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for recipient
                If InStr(UCase(a_Dir(1, M_X)), "__RECIP_VERSION1.0_#") > 0 Then

                    ReDim Preserve a_RecipientsCC(MyArrayLen(a_RecipientsCC, 1) + 1)

                    s_Temp = ""

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then
                            Exit For
                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_39FE") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsCC(MyArrayLen(a_RecipientsCC, 1) - 1) = s_String
                        End If
                    Next

                    ' Get org email
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient display name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_403E") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsCC(MyArrayLen(a_RecipientsCC, 1) - 1) = s_String

                        End If
                    Next

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient display name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3001") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsCC(MyArrayLen(a_RecipientsCC, 1) - 1) = s_String

                        End If
                    Next

                    ' Get recipient type and delete if wrong
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check if its in the TO list
                        If InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 And a_Dir(7, M_Y) > 0 Then

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat)
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            For M_Z = 1 To Len(s_String) Step 8
                                If Mid(s_String, M_Z, 4) = MyHexToHexCoded("0300150C") Then
                                    If MyVBNumber(Mid(s_String, M_Z + 8, 1)) <> 2 And s_Temp <> "" Then
                                        If MyArrayLen(a_RecipientsCC, 1) > 1 Then
                                            ReDim Preserve a_RecipientsCC(MyArrayLen(a_RecipientsCC, 1) - 1)
                                        Else
                                            ReDim a_RecipientsCC(0)
                                        End If
                                    End If
                                End If
                            Next

                        End If

                        ' Check for recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then
                            Exit For
                        End If
                    Next

                End If
            Next

        End If


        If InStr(s_Val, "RECIPIENTSBCC,") > 0 Then

            ' Now get the directory entry for the recipients
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for recipient
                If InStr(UCase(a_Dir(1, M_X)), "__RECIP_VERSION1.0_#") > 0 Then

                    ReDim Preserve a_RecipientsBCC(MyArrayLen(a_RecipientsBCC, 1) + 1)

                    s_Temp = ""

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then
                            Exit For
                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_39FE") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsBCC(MyArrayLen(a_RecipientsBCC, 1) - 1) = s_String
                        End If
                    Next

                    ' Get org email
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient display name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_403E") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsBCC(MyArrayLen(a_RecipientsBCC, 1) - 1) = s_String

                        End If
                    Next

                    ' Get recipient name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for recipient display name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        End If

                        If InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3001") > 0 And a_Dir(7, M_Y) > 0 And s_Temp = "" Then

                            s_Temp = "1"

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            ' Check if valid SMTP address
                            If InStr(s_String, "@") <> 0 Then
                                s_String = Replace(s_String, "<", "")
                                s_String = Replace(s_String, ">", "")
                                s_String = Replace(s_String, "'", "")
                            End If

                            a_RecipientsBCC(MyArrayLen(a_RecipientsBCC, 1) - 1) = s_String

                        End If
                    Next

                    ' Get recipient type and delete if wrong
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check if its in the TO list
                        If InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 And a_Dir(7, M_Y) > 0 Then

                            ' Check if in short stream
                            s_String = ""
                            If a_Dir(7, M_Y) < s_MinStream Then
                                s_String = MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat)
                            Else
                                s_String = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                            For M_Z = 1 To Len(s_String) Step 8
                                If Mid(s_String, M_Z, 4) = MyHexToHexCoded("0300150C") Then
                                    If MyVBNumber(Mid(s_String, M_Z + 8, 1)) <> 3 And s_Temp <> "" Then
                                        If MyArrayLen(a_RecipientsBCC, 1) > 1 Then
                                            ReDim Preserve a_RecipientsBCC(MyArrayLen(a_RecipientsBCC, 1) - 1)
                                        Else
                                            ReDim a_RecipientsBCC(0)
                                        End If
                                    End If
                                End If
                            Next

                        End If

                        ' Check for recipient email
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then
                            Exit For
                        End If
                    Next

                End If
            Next

        End If

        If InStr(s_Val, "ATTACHMENTEXTRACT,") > 0 Then

            ' Now get the directory entry for the attachments
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

                ' Check for attachment
                If InStr(UCase(a_Dir(1, M_X)), "__ATTACH_VERSION1.0_#") > 0 Then

                    ReDim Preserve a_Attachments(MyArrayLen(a_Attachments, 1) + 1)
                    ReDim Preserve a_Attachments2(MyArrayLen(a_Attachments2, 1) + 1)

                    ' Get attachment name
                    For M_Y = M_X + 1 To MyArrayLen(a_Dir, 2) - 1

                        ' Check for attachment name
                        If InStr(UCase(a_Dir(1, M_Y)), "__ATTACH_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__RECIP_VERSION1.0_#") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__NAMEID_VERSION1.0") > 0 Or InStr(UCase(a_Dir(1, M_Y)), "__PROPERTIES_VERSION1.0") > 0 Then

                            Exit For

                        ElseIf InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3701") > 0 Then

                            ' Check if in short stream
                            If a_Dir(7, M_Y) < s_MinStream Then

                                s_Temp = o_FSO.GetSpecialFolder(2) & o_FSO.GetTempName
                                o_File = o_FSO.CreateTextFile(s_Temp, True, False)
                                o_File.Write(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat))
                                a_Attachments(MyArrayLen(a_Attachments, 1) - 1) = s_Temp
                                o_File.Close()

                            Else

                                a_Attachments(MyArrayLen(a_Attachments, 1) - 1) = MyLongSectorReader("FILE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)

                            End If

                        ElseIf InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3704") > 0 Then

                            ' Check if in short stream
                            If a_Dir(7, M_Y) < s_MinStream Then
                                a_Attachments2(MyArrayLen(a_Attachments2, 1) - 1) = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                a_Attachments2(MyArrayLen(a_Attachments2, 1) - 1) = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If

                        ElseIf InStr(UCase(a_Dir(1, M_Y)), "__SUBSTG1.0_3707") > 0 Then

                            ' Check if in short stream
                            If a_Dir(7, M_Y) < s_MinStream Then
                                a_Attachments2(MyArrayLen(a_Attachments2, 1) - 1) = Replace(MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), a_SSAT, s_ShortSat), Chr(0), "")
                            Else
                                a_Attachments2(MyArrayLen(a_Attachments2, 1) - 1) = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_Y), a_Dir(7, M_Y), s_fileName, s_SAT)
                            End If
                        End If
                    Next
                End If
            Next


            ' At this stage we have temporary filenames and an array of names
            ' We now need to:
            ' - Check for existing files
            ' - Rename the temporary files to the new names

            ' Delete files in temporary folder
            For M_X = 0 To MyArrayLen(a_Attachments2, 1) - 1

                ' Check for existing files
                If o_FSO.FileExists(o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X)) Then

                    On Error Resume Next
                    o_FSO.DeleteFile(o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X))
                    On Error GoTo 0

                End If

            Next

            ' Now rename attachments
            For M_X = 0 To MyArrayLen(a_Attachments2, 1) - 1


                ' Check for existing files
                If o_FSO.FileExists(o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X)) Then

                    M_Y = 1
                    Do While o_FSO.FileExists(o_FSO.GetSpecialFolder(2) & "\" & M_Y & a_Attachments2(M_X))
                        M_Y = M_Y + 1
                    Loop

                    o_FSO.MoveFile(a_Attachments(M_X), o_FSO.GetSpecialFolder(2) & "\" & M_Y & a_Attachments2(M_X))
                    a_Attachments(M_X) = o_FSO.GetSpecialFolder(2) & "\" & M_Y & a_Attachments2(M_X)

                Else

                    o_FSO.MoveFile(a_Attachments(M_X), o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X))
                    a_Attachments(M_X) = o_FSO.GetSpecialFolder(2) & "\" & a_Attachments2(M_X)

                End If

            Next
        End If

        ' The date sent
        If InStr(s_Val, "DATESENT,") > 0 Then

            s_Temp = ""
            ' Now get the directory entry for the first properties
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__PROPERTIES_VERSION1.0") > 0 And a_Dir(7, M_X) > 0 Then
                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_Temp = MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat)
                        Exit For
                    Else
                        s_Temp = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If

                End If
            Next

            ' Now we've got the properties lets read them
            For M_X = 1 To Len(s_Temp) Step 16
                If Mid(s_Temp, M_X, 4) = MyHexToHexCoded("40003900") Then
                    s_DateSent = MyGregorianDate(MyVBNumber(Mid(s_Temp, M_X + 8, 8)))
                End If
            Next

        End If

        ' The date received
        If InStr(s_Val, "DATERECEIVED,") > 0 Then

            s_Temp = ""
            ' Now get the directory entry for the first properties
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__PROPERTIES_VERSION1.0") > 0 And a_Dir(7, M_X) > 0 Then
                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_Temp = MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat)
                        Exit For
                    Else
                        s_Temp = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If

                End If
            Next

            ' Now we've got the properties lets read them
            s_DateReceived = ""
            For M_X = 1 To Len(s_Temp) Step 16
                If Mid(s_Temp, M_X, 4) = MyHexToHexCoded("4000060E") Then
                    s_DateReceived = MyGregorianDate(MyVBNumber(Mid(s_Temp, M_X + 8, 8)))
                End If
            Next

        End If


        ' The date reply requested
        If InStr(s_Val, "DATEREPLY,") > 0 Then

            s_Temp = ""
            ' Now get the directory entry for the first properties
            For M_X = 0 To MyArrayLen(a_Dir, 2) - 1
                If InStr(UCase(a_Dir(1, M_X)), "__PROPERTIES_VERSION1.0") > 0 And a_Dir(7, M_X) > 0 Then
                    ' Check if in short stream
                    If a_Dir(7, M_X) < s_MinStream Then
                        s_Temp = MyShortSectorReader(s_ShortSectSize, a_Dir(6, M_X), a_Dir(7, M_X), a_SSAT, s_ShortSat)
                        Exit For
                    Else
                        s_Temp = MyLongSectorReader("VARIABLE", s_SectSize, a_Dir(6, M_X), a_Dir(7, M_X), s_fileName, s_SAT)
                        Exit For
                    End If

                End If
            Next

            ' Now we've got the properties lets read them
            s_DateReply = ""
            For M_X = 1 To Len(s_Temp) Step 16
                If Mid(s_Temp, M_X, 4) = MyHexToHexCoded("40003000") Then
                    s_DateReply = MyGregorianDate(MyVBNumber(Mid(s_Temp, M_X + 8, 8)))
                End If
            Next

        End If

        ' Build the return string by checking what was asked for
        a_Val = Split(s_Val, ",")
        s_Return = ""
        For M_X = 0 To MyArrayLen(a_Val, 1) - 1

            If Len(Trim(a_Val(M_X))) <> 0 Then

                If UCase(Trim(a_Val(M_X))) = "SUBJECT" Then
                    If s_Return = "" Then
                        If Len(s_Subject) > 0 Then
                            s_Return = s_Return & s_Subject
                        Else
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_Subject
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "MESSAGEID" Then
                    If s_Return = "" Then
                        If Len(s_MessageID) > 0 Then
                            s_Return = s_Return & s_MessageID
                        Else
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_MessageID
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "FROM" Then
                    If s_Return = "" Then
                        If Len(s_From) > 0 Then
                            s_Return = s_Return & s_From
                        Else
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_From
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "PREFIX" Then
                    If s_Return = "" Then
                        If Len(s_Prefix) > 0 Then
                            s_Return = s_Return & s_Prefix
                        Else
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_Prefix
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "BODY" Then
                    If s_Return = "" Then
                        If Len(s_Body) > 0 Then
                            s_Return = s_Return & s_Body
                        Else
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_Body
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "ATTACHMENTNUMBERS" Then
                    If s_Return = "" Then
                        If Len(s_AttachNums) > 0 Then
                            s_Return = s_AttachNums
                        Else
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_AttachNums
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "ATTACHMENTNAMES" Then
                    If s_Return = "" Then
                        For M_Y = 0 To MyArrayLen(a_AttachNames, 1) - 1
                            s_Return = s_Return & a_AttachNames(M_Y) & "|"
                        Next
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^"
                        For M_Y = 0 To MyArrayLen(a_AttachNames, 1) - 1
                            s_Return = s_Return & a_AttachNames(M_Y) & "|"
                        Next
                    End If
                    If Right(s_Return, 1) = "|" Then
                        s_Return = Left(s_Return, Len(s_Return) - 1)
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "RECIPIENTS" Then
                    If s_Return = "" Then
                        For M_Y = 0 To MyArrayLen(a_Recipients, 1) - 1
                            s_Return = s_Return & a_Recipients(M_Y) & "|"
                        Next
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^"
                        For M_Y = 0 To MyArrayLen(a_Recipients, 1) - 1
                            s_Return = s_Return & a_Recipients(M_Y) & "|"
                        Next
                    End If
                    If Right(s_Return, 1) = "|" Then
                        s_Return = Left(s_Return, Len(s_Return) - 1)
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "RECIPIENTSTO" Then
                    If s_Return = "" Then
                        For M_Y = 0 To MyArrayLen(a_RecipientsTo, 1) - 1
                            s_Return = s_Return & a_RecipientsTo(M_Y) & "|"
                        Next
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^"
                        For M_Y = 0 To MyArrayLen(a_RecipientsTo, 1) - 1
                            s_Return = s_Return & a_RecipientsTo(M_Y) & "|"
                        Next
                    End If
                    If Right(s_Return, 1) = "|" Then
                        s_Return = Left(s_Return, Len(s_Return) - 1)
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "RECIPIENTSCC" Then
                    If s_Return = "" Then
                        For M_Y = 0 To MyArrayLen(a_RecipientsCC, 1) - 1
                            s_Return = s_Return & a_RecipientsCC(M_Y) & "|"
                        Next
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^"
                        For M_Y = 0 To MyArrayLen(a_RecipientsCC, 1) - 1
                            s_Return = s_Return & a_RecipientsCC(M_Y) & "|"
                        Next
                    End If
                    If Right(s_Return, 1) = "|" Then
                        s_Return = Left(s_Return, Len(s_Return) - 1)
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "RECIPIENTSBCC" Then
                    If s_Return = "" Then
                        For M_Y = 0 To MyArrayLen(a_RecipientsBCC, 1) - 1
                            s_Return = s_Return & a_RecipientsBCC(M_Y) & "|"
                        Next
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^"
                        For M_Y = 0 To MyArrayLen(a_RecipientsBCC, 1) - 1
                            s_Return = s_Return & a_RecipientsBCC(M_Y) & "|"
                        Next
                    End If
                    If Right(s_Return, 1) = "|" Then
                        s_Return = Left(s_Return, Len(s_Return) - 1)
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "ATTACHMENTEXTRACT" Then
                    If s_Return = "" Then
                        For M_Y = 0 To MyArrayLen(a_Attachments, 1) - 1
                            s_Return = s_Return & a_Attachments(M_Y) & "|"
                        Next
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^"
                        For M_Y = 0 To MyArrayLen(a_Attachments, 1) - 1
                            s_Return = s_Return & a_Attachments(M_Y) & "|"
                        Next
                    End If
                    If Right(s_Return, 1) = "|" Then
                        s_Return = Left(s_Return, Len(s_Return) - 1)
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "DATESENT" Then
                    If s_Return = "" Then
                        s_Return = s_DateSent
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_DateSent
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "DATERECEIVED" Then
                    If s_Return = "" Then
                        s_Return = s_DateReceived
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_DateReceived
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "DATEREPLY" Then
                    If s_Return = "" Then
                        s_Return = s_DateReply
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_DateReply
                    End If
                End If

                If UCase(Trim(a_Val(M_X))) = "REPLYTYPE" Then
                    If s_Return = "" Then
                        s_Return = s_ReplyType
                        If Len(s_Return) = 0 Then
                            s_Return = " "
                        End If
                    Else
                        s_Return = s_Return & "^" & s_ReplyType
                    End If
                End If

            End If
        Next

        MsgGet = s_Return

        o_File = Nothing
        o_FSO = Nothing
    End Function


    Function MyHexToHexCoded(ByVal s_String)
        ' **********************************************************************************
        ' Description : Takes a string such as "D0CF" and returns a HEX string which can be
        '               compared with characters read from a file
        ' Created     : 24/12/2005
        ' Version     : 1.0
        ' **********************************************************************************
        Dim M_X
        Dim s_Temp

        s_Temp = ""
        For M_X = 1 To Len(s_String) Step 2
            s_Temp = s_Temp & Chr(CLng("&H" & Mid(s_String, M_X, 2)))
        Next
        MyHexToHexCoded = s_Temp
    End Function


    Function MyVBNumber(ByVal s_String)
        ' **********************************************************************************
        ' Description : Takes chars read from file and converts to number
        ' Created     : 24/12/2005
        ' Version     : 1.0
        ' **********************************************************************************

        MyVBNumber = 0
        If Len(s_String) = 1 Then
            If Asc(Mid(s_String, 1, 1)) = 255 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 254 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 253 Then
                MyVBNumber = -2
            ElseIf Asc(Mid(s_String, 1, 1)) = 252 Then
                MyVBNumber = -3
            ElseIf Asc(Mid(s_String, 1, 1)) = 251 Then
                MyVBNumber = -4
            Else
                MyVBNumber = Asc(Mid(s_String, 1, 1))
            End If
        ElseIf Len(s_String) = 2 Then
            If Asc(Mid(s_String, 1, 1)) = 255 And Asc(Mid(s_String, 2, 1)) = 255 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 254 And Asc(Mid(s_String, 2, 1)) = 255 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 253 And Asc(Mid(s_String, 2, 1)) = 255 Then
                MyVBNumber = -2
            ElseIf Asc(Mid(s_String, 1, 1)) = 252 And Asc(Mid(s_String, 2, 1)) = 255 Then
                MyVBNumber = -3
            ElseIf Asc(Mid(s_String, 1, 1)) = 251 And Asc(Mid(s_String, 2, 1)) = 255 Then
                MyVBNumber = -4
            Else
                MyVBNumber = Asc(Mid(s_String, 1, 1)) + Asc(Mid(s_String, 2, 1)) * 256
            End If
        ElseIf Len(s_String) = 4 Then
            If Asc(Mid(s_String, 1, 1)) = 255 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 254 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 253 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 Then
                MyVBNumber = -2
            ElseIf Asc(Mid(s_String, 1, 1)) = 252 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 Then
                MyVBNumber = -3
            ElseIf Asc(Mid(s_String, 1, 1)) = 251 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 Then
                MyVBNumber = -4
            Else
                MyVBNumber = Asc(Mid(s_String, 1, 1)) + Asc(Mid(s_String, 2, 1)) * 256 + Asc(Mid(s_String, 3, 1)) * 65536 + Asc(Mid(s_String, 4, 1)) * 16777216
            End If
        ElseIf Len(s_String) = 8 Then
            If Asc(Mid(s_String, 1, 1)) = 255 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 And Asc(Mid(s_String, 5, 1)) = 255 And Asc(Mid(s_String, 6, 1)) = 255 And Asc(Mid(s_String, 7, 1)) = 255 And Asc(Mid(s_String, 8, 1)) = 255 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 254 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 And Asc(Mid(s_String, 5, 1)) = 255 And Asc(Mid(s_String, 6, 1)) = 255 And Asc(Mid(s_String, 7, 1)) = 255 And Asc(Mid(s_String, 8, 1)) = 255 Then
                MyVBNumber = -1
            ElseIf Asc(Mid(s_String, 1, 1)) = 253 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 And Asc(Mid(s_String, 5, 1)) = 255 And Asc(Mid(s_String, 6, 1)) = 255 And Asc(Mid(s_String, 7, 1)) = 255 And Asc(Mid(s_String, 8, 1)) = 255 Then
                MyVBNumber = -2
            ElseIf Asc(Mid(s_String, 1, 1)) = 252 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 And Asc(Mid(s_String, 5, 1)) = 255 And Asc(Mid(s_String, 6, 1)) = 255 And Asc(Mid(s_String, 7, 1)) = 255 And Asc(Mid(s_String, 8, 1)) = 255 Then
                MyVBNumber = -3
            ElseIf Asc(Mid(s_String, 1, 1)) = 251 And Asc(Mid(s_String, 2, 1)) = 255 And Asc(Mid(s_String, 3, 1)) = 255 And Asc(Mid(s_String, 4, 1)) = 255 And Asc(Mid(s_String, 5, 1)) = 255 And Asc(Mid(s_String, 6, 1)) = 255 And Asc(Mid(s_String, 7, 1)) = 255 And Asc(Mid(s_String, 8, 1)) = 255 Then
                MyVBNumber = -4
            Else
                MyVBNumber = Asc(Mid(s_String, 1, 1)) + Asc(Mid(s_String, 2, 1)) * 256 + Asc(Mid(s_String, 3, 1)) * 65536 + Asc(Mid(s_String, 4, 1)) * 16777216 + Asc(Mid(s_String, 5, 1)) * 4294967296 + Asc(Mid(s_String, 6, 1)) * 1099511627776 + Asc(Mid(s_String, 7, 1)) * 281474976710656 + Asc(Mid(s_String, 8, 1)) * 72057594037927900
            End If
        End If
    End Function


    Function MyArrayLen(ByVal MyArray, ByVal MyDim)
        ' *****************************************************************************
        ' Function    : MyArrayLen
        ' Arguments   : Array to get length of
        '                  Dimension of array to test
        ' Returns     : Length of array
        ' Description : Returns the length of an array even if it is null or not
        '               defined. UBound does not work on some types of variant array
        '               so discovered best to use For Each when dimension 1 and UBound
        '               for other dimensions.
        ' Created     : 20/10/2001 S Currie
        ' *****************************************************************************
        Dim MyLength
        MyLength = 0
        On Error Resume Next
        MyLength = UBound(MyArray, MyDim)
        If MyLength < 0 Then
            MyLength = 0
        End If
        MyArrayLen = MyLength
    End Function

    Function MySectorReader(ByVal s_SectSize, ByVal s_SID, ByVal s_FileName)
        ' **********************************************************************************
        ' Description : Reads a number of characters from a particular sector in a file
        ' Arguments   :      The size of the sectors to be read
        '                         The particluar sector to be read
        '                    The filename which they are to be read from
        ' Created     : 30/12/2005
        ' Version     : 1.0
        ' **********************************************************************************
        Dim o_FSO
        Dim o_File

        ' Create object and get the file
        o_FSO = My.Computer.FileSystem

        If Not o_FSO.FileExists(s_FileName) Then
            MySectorReader = ""
            Exit Function
        End If
        If UCase(Right(s_FileName, 4)) <> ".MSG" Then
            MySectorReader = ""
            Exit Function
        End If

        o_File = o_FSO.OpenTextFile(s_FileName, 1, -1)

        ' Now read up to the sector
        o_File.Skip((s_SID * s_SectSize) + s_SectSize)

        ' Now read the sector itself
        On Error Resume Next
        MySectorReader = o_File.Read(s_SectSize)

        o_File.Close()
        o_File = Nothing
        o_FSO = Nothing

    End Function

    Function MyShortSectorReader(ByVal s_ShortSectSize, ByVal s_SID, ByVal s_Size, ByVal a_SSAT, ByVal s_ShortSat)
        ' **********************************************************************************
        ' Description : Reads a number of characters from the short sector container which
        '               is held in the memory variable s_ShortSat. The a_SSAT is a directory
        '               array which tell you how to access the s_ShortSat
        ' Arguments   :      The size of the sectors to be read
        '                              The particluar sector to be read within s_ShortSat
        '                             The size of the value to return
        '                             The array which contains the details of how to
        '                                     access the s_ShortSat
        '                         This is the short container stream read from
        '                                     the file
        ' Created     : 31/12/2005
        ' Version     : 1.0
        ' **********************************************************************************
        Dim M_Y
        Dim s_Temp

        M_Y = s_SID
        s_Temp = Mid(s_ShortSat, s_SID * s_ShortSectSize + 1, s_ShortSectSize)

        Do While True
            M_Y = a_SSAT(M_Y)
            If M_Y > 0 Then
                s_Temp = s_Temp & Mid(s_ShortSat, M_Y * s_ShortSectSize + 1, s_ShortSectSize)
            End If
            If Len(s_Temp) >= s_Size Then
                Exit Do
            End If
        Loop
        MyShortSectorReader = Mid(s_Temp, 1, s_Size)
    End Function

    Function MyLongSectorReader(ByVal s_ReturnType, ByVal s_SectSize, ByVal s_SID, ByVal s_Size, ByVal s_FileName, ByVal s_SAT)
        ' **********************************************************************************
        ' Description : Reads a number of characters from the short sector container which
        '               is held in the memory variable s_ShortSat. The a_SSAT is a directory
        '               array which tell you how to access the s_ShortSat
        ' Arguments   : <
        '                         The size of the sectors to be read
        '                              The particluar sector to be read within s_ShortSat
        '                             The size of the value to return
        '                             The array which contains the details of how to
        '                                     access the s_ShortSat
        '                         This is the short container stream read from
        '                                     the file
        ' Created     : 31/12/2005
        ' Version     : 1.0
        ' **********************************************************************************
        Dim M_Y
        Dim s_Temp = Nothing
        Dim o_FSO
        Dim o_File
        Dim M_X
        Dim s_Start
        Dim s_Previous
        Dim s_Sects

        M_X = s_Size
        MyLongSectorReader = ""
        If s_ReturnType = "FILE" Then

            ' Create object and the file
            o_FSO = My.Computer.FileSystem

            s_Temp = o_FSO.GetSpecialFolder(2) & "\" & o_FSO.GetTempName
            o_File = o_FSO.CreateTextFile(s_Temp, True, False)

            M_Y = s_SID
            o_File.Write(MySectorReader(s_SectSize, M_Y, s_FileName))
            M_X = M_X - s_SectSize

            s_Previous = -99
            s_Sects = 0
            s_Start = 0
            Do While True

                M_Y = MyVBNumber(Mid(s_SAT, (M_Y * 4) + 1, 4))

                If s_Previous = M_Y - 1 Then

                    s_Previous = M_Y
                    s_Sects = s_Sects + 1

                ElseIf s_Previous <> M_Y - 1 Then

                    If s_Sects > 0 Then

                        M_X = M_X - (s_SectSize * s_Sects)
                        o_File.Write(MyMultiSectorReader(s_SectSize, s_Start, s_FileName, s_Sects))

                    End If

                    s_Previous = M_Y
                    s_Sects = 1
                    s_Start = M_Y

                End If

                If M_X <= 0 Then
                    Exit Do
                End If

            Loop

            o_File.Close()

        ElseIf s_ReturnType = "VARIABLE" Then

            M_Y = s_SID
            s_Temp = MySectorReader(s_SectSize, M_Y, s_FileName)

            Do While True

                M_Y = MyVBNumber(Mid(s_SAT, (M_Y * 4) + 1, 4))
                If M_Y > 0 Then
                    s_Temp = s_Temp & MySectorReader(s_SectSize, M_Y, s_FileName)
                End If
                If Len(s_Temp) >= s_Size Then
                    Exit Do
                End If
            Loop

            s_Temp = Mid(s_Temp, 1, s_Size)

        End If
        MyLongSectorReader = s_Temp
    End Function

    Function MyMultiSectorReader(ByVal s_SectSize, ByVal s_SID, ByVal s_FileName, ByVal s_Number)
        ' **********************************************************************************
        ' Description : Reads a number of characters from a particular sector in a file
        ' Arguments   :      The size of the sectors to be read
        '                         The particluar sector to be read
        '                    The filename which they are to be read from
        '                      The number of sectors to read
        ' Created     : 01/01/2006
        ' Version     : 1.0
        ' **********************************************************************************
        Dim o_FSO
        Dim o_File

        ' Create object and get the file
        o_FSO = My.Computer.FileSystem

        If Not o_FSO.FileExists(s_FileName) Then
            MyMultiSectorReader = ""
            Exit Function
        End If
        If UCase(Right(s_FileName, 4)) <> ".MSG" Then
            MyMultiSectorReader = ""
            Exit Function
        End If

        o_File = o_FSO.OpenTextFile(s_FileName, 1, -1)

        ' Now read up to the sector
        o_File.Skip((s_SID * s_SectSize) + s_SectSize)

        ' Now read the sector itself
        On Error Resume Next
        MyMultiSectorReader = o_File.Read(s_SectSize * s_Number)

        o_File.Close()
        o_File = Nothing
        o_FSO = Nothing
    End Function

    Function MyGregorianDate(ByVal l_Val)
        ' **********************************************************************************
        ' Description : Returns a date from a property tag in Outlook properties
        ' Arguments   :      The VB number to convert
        ' Created     : 03/02/2007
        ' Version     : 1.0
        ' **********************************************************************************
        Dim l_FracSecs
        Dim l_RemSecs
        Dim l_Secs
        Dim l_RemMins
        Dim l_Mins
        Dim l_RemHours
        Dim l_Hours
        Dim l_RemDays
        Dim l_Year
        Dim l_RemDays2

        l_FracSecs = ((l_Val / 10000000) - Int(l_Val / 10000000)) * 10000000
        l_RemSecs = l_Val / 10000000
        l_Secs = Math.Round(((l_RemSecs / 60) - Int(l_RemSecs / 60)) * 60, 0)
        l_RemMins = Int(l_RemSecs / 60)
        l_Mins = Math.Round(((l_RemMins / 60) - Int(l_RemMins / 60)) * 60, 0)
        l_RemHours = Int(l_RemMins / 60)
        l_Hours = Math.Round(((l_RemHours / 24) - Int(l_RemHours / 24)) * 24, 0)
        l_RemDays = Int(l_RemHours / 24)
        l_Year = 1601 + Int(l_RemDays / 365)
        'l_RemDays2 = 109572 + DateSerial(l_Year, 1, 1) - DateSerial(1901, 1, 1)
        'MyGregorianDate = DateAdd("d", l_RemDays - l_RemDays2, "01/01/" & l_Year)
        'MyGregorianDate = DateAdd("h", l_Hours, MyGregorianDate)
        'MyGregorianDate = DateAdd("n", l_Mins, MyGregorianDate)
        'MyGregorianDate = DateAdd("s", l_Secs, MyGregorianDate)

        If Year(MyGregorianDate) < 1902 Then
            MyGregorianDate = ""
        End If
    End Function

    Function MySubRead(ByVal l_Left, ByVal l_Right, ByVal a_Dir, ByVal a_Temp)
        MySubRead = Nothing
        ' **********************************************************************************
        ' Description : Reads a directory structure backwards and forwards
        ' Arguments   :      The directory entry
        ' Created     : 23/02/2007
        ' Version     : 1.0
        ' **********************************************************************************
        Dim M_X

        For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

            If a_Dir(0, M_X) = l_Left Then


                If a_Dir(3, M_X) <> -1 Then
                    MySubRead(a_Dir(3, M_X), -1, a_Dir, a_Temp)
                End If

                If a_Dir(5, M_X) = -1 Then

                    ' Add to final array
                    ReDim Preserve a_Temp(8, MyArrayLen(a_Temp, 2) + 1)

                    a_Temp(0, MyArrayLen(a_Temp, 2) - 1) = a_Dir(0, M_X)
                    a_Temp(1, MyArrayLen(a_Temp, 2) - 1) = a_Dir(1, M_X)
                    a_Temp(2, MyArrayLen(a_Temp, 2) - 1) = a_Dir(2, M_X)
                    a_Temp(3, MyArrayLen(a_Temp, 2) - 1) = a_Dir(3, M_X)
                    a_Temp(4, MyArrayLen(a_Temp, 2) - 1) = a_Dir(4, M_X)
                    a_Temp(5, MyArrayLen(a_Temp, 2) - 1) = a_Dir(5, M_X)
                    a_Temp(6, MyArrayLen(a_Temp, 2) - 1) = a_Dir(6, M_X)
                    a_Temp(7, MyArrayLen(a_Temp, 2) - 1) = a_Dir(7, M_X)

                End If

            End If


        Next

        For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

            If a_Dir(0, M_X) = l_Left Then

                If a_Dir(4, M_X) <> -1 Then
                    MySubRead(-1, a_Dir(4, M_X), a_Dir, a_Temp)
                End If

            End If

        Next

        For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

            If a_Dir(0, M_X) = l_Right Then


                If a_Dir(3, M_X) <> -1 Then
                    MySubRead(a_Dir(3, M_X), -1, a_Dir, a_Temp)
                End If

                If a_Dir(5, M_X) = -1 Then
                    ' Add to final array
                    ReDim Preserve a_Temp(8, MyArrayLen(a_Temp, 2) + 1)

                    a_Temp(0, MyArrayLen(a_Temp, 2) - 1) = a_Dir(0, M_X)
                    a_Temp(1, MyArrayLen(a_Temp, 2) - 1) = a_Dir(1, M_X)
                    a_Temp(2, MyArrayLen(a_Temp, 2) - 1) = a_Dir(2, M_X)
                    a_Temp(3, MyArrayLen(a_Temp, 2) - 1) = a_Dir(3, M_X)
                    a_Temp(4, MyArrayLen(a_Temp, 2) - 1) = a_Dir(4, M_X)
                    a_Temp(5, MyArrayLen(a_Temp, 2) - 1) = a_Dir(5, M_X)
                    a_Temp(6, MyArrayLen(a_Temp, 2) - 1) = a_Dir(6, M_X)
                    a_Temp(7, MyArrayLen(a_Temp, 2) - 1) = a_Dir(7, M_X)

                End If

            End If

        Next

        For M_X = 0 To MyArrayLen(a_Dir, 2) - 1

            If a_Dir(0, M_X) = l_Right Then


                If a_Dir(4, M_X) <> -1 Then
                    MySubRead(-1, a_Dir(4, M_X), a_Dir, a_Temp)
                End If

            End If

        Next
    End Function
End Module

Una brutta faccenda che, come si comprende, potrebbe nuocere alla popolarità dell'ingegnoso quanto incauto sviluppatore...

Potrebbe consistere nell'occultare anziché disabilitare. In tal caso però - diosaperché, io no - la proprietà Visible = False non si lascia applicare alla barra dei menu, e chi si accontenta dovrebbe limitarsi al ciclo seguente:

Agli amanti dei modelli dittatoriali, di sicuro insoddisfatti della soluzione appena vista, suggerisco infine di aggiungere l'istruzione seguente:

Office 2007, qui comincia l’avventura, anche sul Web

Questa guida introduttiva ha battuto i concorrenti uscendo per prima e con la benedizione di Microsoft Italia: prefazione a cura della medesima e omaggio ai partecipanti a un Convegno dedicato ai partner. Nell’accingermi a recensirla, quasi non mi accorgevo che, nel frattempo, vi sono state aggiunte 68 pagine, dedicate all’uso della versione on line del package, fruibile in virtù di una “finestra” (netframe) Citrix, evidenziandone anche i pregi documentari e didattici, come demo interattiva e quiz.

Il tutto a riprova del dinamismo di questo giovane editore che da qualche tempo offre al mercato testi, soprattutto (ma non solo) introduttivi di microinformatica a costi ragionevoli e con una simpatica veste editoriale. Anche la gentile autrice, una colonna delle Edizioni FAG, si deve esser data da fare, riuscendo nell’intento di offrire una descrizione accurata e chiara dei connotati salienti di Office 2007 e senza limitarsi agli aspetti operativi e a quelli ergonomici, che pure abbondano in una suite esteticamente molto curata. I primi capitoli, infatti, spiegano a dovere la nuova struttura XML dei documenti Office, arrivando a illustrarne la fruibilità anche in applicativi diversi da quelli di casa MS. Idem per la novità (confondente, a parere di chi scrive) dei doppi formati, con e senza macro VBA.

Seguono capitoli dedicati, ciascuno, ai principali membri della neonata famiglia, focalizzandone opportunamente le novità, a volte non immediate da scoprire (come la nuova casella delle formule di Excel, dimensionabile in modo da mostrare le formulacce più estese) e illustrando i potenziamenti più importanti. Opportuno ad esempio quello sulle tabelle, per restare a Excel, ma anche le migliorie di Word, PowerPoint, Access e Outlook sono ben trattate. Una sola omissione, strana anche se veniale: manca la citazione del cospicuo potenziamento in colonne e righe dei fogli di lavoro: 1.048.586 x 16.384 (di cui però tutti si accorgono prestissimo).

Insomma il libro è doppiamente utile per chi si avvicina a Office 2007, in modo sia virtuale che reale.

Alessandra Salvaggio

Microsoft Office Sytem 2007 + Microsoft Office Online

EDIZIONI FAG – MILANO (www.fag.it)

Pagg. 208

€ 12,90

Indirizzi e-mail per utenti giramondo

Questa è un’ideuzza semplice che si rivolge ai principianti ma insegna anche ad altri almeno un segretoccio.

Obiettivo. Creare un foglio Excel contenente i dati essenziali relativi ai propri contatti, del tipo seguente.

Il vantaggio del modellino è evidente: consente a chi si trova fuori sede di portarsi appresso indirizzi e usufruirne rapidamente su un PC altrui o in qualche Internet Point. Va subito sottolineata l’importanza che gli indirizzi in colonna D siano in forma di hyperlink, così basterà un clic su uno di essi per attivare automaticamente l’Outlook locale.

Ed ecco le mosse necessarie.

1. Esportare i Contatti del nostro Outlook in un file Excel, diciamo ContattiOutlk.xls, col comando File > Importa esporta... con quel che segue (modalità date per note),, magari rinunciando già in tale sede ai campi che non ci interessano, potatura che può farsi anche in Excel.
2. Completare tutti i campi Nome e Cognome (è un consiglio e rappresenta l’occasione di mettere un po’ d’ordine nella nostra Posta elettronica)
3. Aggiungere la colonna A intestata NOME_COGN come in figura. Anche questo è un cosiglio, la colonna potrebbe essere sull’estrema destra, l’importante è che nelle colonne da A2 in giù vengano inserite le formule seguenti, che fanno compariire il Nome + Cognome dei vari soggetti:
   =B2&" "&C2
   =B3&" "&C3
   =B2&" "&C2
   eccetera
4. Impostare il Filtro Automatico, con il comando specifico del menu Dati. In tal modo basterà un clic sulla colonna NOME_COGN per vedersi spaparanzare tale elenco da cui scegliere un contatto: così si vedrà una sola riga evidenziandone l’indirizzo e-mail.
5. Dare un clic su tale indirizzo e proseguire con Outlook.

Tutto piuttosto semplice e scontato, ma c’è un’operazione che stavo dimenticando (di proposito, però, per una certa suspense...):

6. Lanciare la macro CreaLink qui sotto indicata

Sub CreaHyperlink(Colonna As Range)

  Dim Cella As Range, txtLink As String

  For Each Cella In Colonna

    txtLink = Cella.Text

    Cella.Hyperlinks.Add Anchor:=Cella, Address:= _

        "mailto:" & txtLink, TextToDisplay:=txtLink

  Next

End Sub

Sub CreaLink()

  With Range("IndirPostaElettr")

    CreaHyperlink Range(.Cells(2), .End(xlDown))

  End With

End Sub

Ma come mai occorre una macro? Il motivo lo scoprono tutti al termine dell’esportazione dei Contatti: la colonna degli indirizzi è in forma di testo pertanto non si ha subito il beneficio del clic che richiama Outlook. Per rendersene più esattamente conto si vada su una cella come D2 e si prema il tasto F2. Il minieditor di cella ci svela la presenza di un apice (‘) anteposto, ossia si vede ‘alessand@amba.it. Se si toglie tale apice e si preme Invio si assisterà alla nobilitazione della stringa in un azzurrino link... postelegrafonico.

Ma questo ripiego manuale è troppo lungo e tedioso. La macro compie il lavoro in qualche secondo.