Import Outlook 2007 emails with vba

I'm am trying to import the body of emails that are located in a specific folder in Outlook 2007

The email folder name is 2 Showtime

The access table I want to import them into is  Email

The name of the field the table  Remarks

My email is on an exchange server

In researching EE I found the code below and tried to tweak it for my purposes... but alas no luck.

Does the code need to be written differently since i am on an exchange server?



    Dim objOutlook As Object 'Outlook.Application
    Dim objNameSpace As Object 'Outlook.NameSpace
    Dim objMAPI As Object 'Outlook.MAPIFolder
    Dim objItems As Object 'Outlook.Items
    Dim objMailItem As Object
    Dim sSubject As String
    Dim sBody As String
    Dim i As Integer, j As Integer
    Dim lFolderID
    Dim rs As DAO.Recordset

   
    Set objOutlook = CreateObject("Outlook.Application") 'New Outlook.Application
    Set objNameSpace = objOutlook.GetNamespace("MAPI")          'Get to the current session of Outlook.



'Find out folder - assume its within Personal Folders and its called accept
    lFolderID = -1
    For i = 1 To objNameSpace.Folders.Count

        If InStr(1, objNameSpace.Folders(i).Name, "Personal Folder") > 0 Then
        MsgBox InStr(1, objNameSpace.Folders(i).Name, "Mailbox - Ashley Lowe")
            For j = 1 To objNameSpace.Folders.Item(i).Folders.Count

                If objNameSpace.Folders.Item(i).Folders.Item(j).Name = "2 Showtime" Then
               
                    lFolderID = objNameSpace.Folders.Item(i).Folders.Item(j).EntryID
                End If
            Next j
        End If
    Next i

    If lFolderID <> -1 Then
   
        Set objMAPI = objNameSpace.GetFolderFromID(lFolderID)
        Set objItems = objMAPI.Items
   
        If objItems.Count = 0 Then
            MsgBox "No mail items found"
           
        Else
       
            Set rs = CurrentDb.OpenRecordset("Email")

            For Each objMailItem In objItems
           
                sSubject = objMailItem.Subject
                sBody = objMailItem.Body
                Debug.Print sSubject

                'DO INSERT HERE
                With rs

                    !Remarks = sBody

                    .Update
                End With
               
            Next

            rs.Close
            Set rs = Nothing
        End If
    End If