Sub extractFolders(strMailboxName, intFullName, objNameSpace)
    'On Error Resume Next

    Dim objFolder
    Dim objMsg
    Dim strAttachments
    Dim Atmt
    Dim strSenderEmailAddress
    Dim strRecipientEmails
    Dim RecptEmail
    Dim objEmails
    Dim intItemCount

    For Each objFolder In objNameSpace.Folders

        DoEvents

        If objFolder.Name = strMailboxName Or (InStr(intFullName & "\" & objFolder.Name, "\" & strMailboxName & "\") > 0 And _
            objFolder.Name <> "RSS Feeds" And _
            objFolder.Name <> "Junk E-mail" And _
            objFolder.Name <> "News Feed" And _
            objFolder.Name <> "Sync Issues" And _
            objFolder.Name <> "Tasks" And _
            objFolder.Name <> "Suggested Contacts" And _
            objFolder.Name <> "Sent Items" And _
            objFolder.Name <> "Quick Step Settings" And _
            objFolder.Name <> "Outbox" And _
            objFolder.Name <> "Junk E-Mail" And _
            objFolder.Name <> "Journal" And _
            objFolder.Name <> "Drafts" And _
            objFolder.Name <> "Deleted Items" And _
            objFolder.Name <> "Conversation Action Settings" And _
            objFolder.Name <> "Contacts" And _
            objFolder.Name <> "Calendar" And _
            objFolder.Name <> "Insulator" And _
            objFolder.Name <> "Notes") Then

            Set objEmails = objFolder.Items

            objEmails.Sort "[ReceivedTime]", True

            Set objEmails = objEmails.Restrict("[ReceivedTime] > '" & DateAdd("d", -1, DateAdd("m", -6, Date)) & "'")

            intItemCount = objEmails.count

            Do While intItemCount > 0

                DoEvents

                If TypeName(objEmails(intItemCount)) = "MailItem" Then

                    Set objMsg = objEmails(intItemCount)

                    With objMsg
                        strAttachments = ""

                        For Each Atmt In .Attachments
                            If Atmt <> "Picture (Device Independent Bitmap)" Then
                                If Left(Atmt.FileName, 5) <> "image" And Right(Atmt.FileName, 3) <> "png" Then
                                    If strAttachments <> "" Then strAttachments = strAttachments & "; "

                                    strAttachments = strAttachments & Atmt.FileName
                                End If
                            End If
                        Next

                        strSenderEmailAddress = .SenderEmailAddress
                        If InStr(strSenderEmailAddress, "/") > 0 Then
                            'strSenderEmailAddress = .Sender.GetExchangeUser.PrimarySmtpAddress
                        End If

                        strRecipientEmails = ""

                        For Each RecptEmail In .Recipients
                            If strRecipientEmails <> "" Then strRecipientEmails = strRecipientEmails & "; "

                            'If InStr(RecptEmail.Address, "/") > 0 Then
                            '    Err.Clear

                            '    strRecipientEmails = strRecipientEmails & RecptEmail.AddressEntry.GetExchangeUser.PrimarySmtpAddress

                            '    If Err.Number <> 0 Then
                            '        strRecipientEmails = strRecipientEmails & "Unresolved Recipient Address"
                            '        Err.Clear
                            '    End If
                            'Else
                                strRecipientEmails = strRecipientEmails & RecptEmail '.AddressEntry.Address
                            'End If
                        Next

                        saveEmailData .EntryID, .Subject, .SenderName, strSenderEmailAddress, .To, strRecipientEmails, strAttachments, .CC, .flagStatus, .TaskCompletedDate, .Categories, .ReceivedTime, intFullName & "\" & objFolder.Name, strMailboxName, .Body
                    End With
                End If

                intItemCount = intItemCount - 1
            Loop

            If objFolder.Folders.count > 0 Then
                extractFolders strMailboxName, intFullName & "\" & objFolder.Name, objFolder
            End If
        End If
    Next
End Sub