Read outlook folders from ms access

For now, lets focus on Inbox only to develope the code to read Outlook in for.

Compile befor runing it.

Mike

In a module add:
 
Sub AuditOutlook()
On Error GoTo err_att
    
    Dim I As Integer
    Dim objApp As Outlook.Application
    Dim obj_ns As Outlook.NameSpace
    Dim obj_CurrentOlkFolder As Outlook.MAPIFolder
    Dim objItem As Object
    Dim mailitem As mailitem
    Dim SenderEmial As String
    Dim SenderInit As String
    Dim CCemial As String
    Dim Sender_Name As String
    Dim BCCemial As String
    Dim SentDateErr As Date
 
    Set objApp = CreateObject("outlook.application")
    Set obj_ns = objApp.GetNamespace("MAPI")
    Set obj_CurrentOlkFolder = obj_ns.GetDefaultFolder(olFolderInbox)
 
    For Each objItem In obj_CurrentOlkFolder.Items
        If TypeName(objItem) = "MailItem" Then
            Set mailitem = objItem
            With mailitem
                
                SenderEmial = .SenderEmailAddress
                CCemial = .CC
                BCCemial = .BCC
                SentDateErr = .SentOn
                Sender_Name = .SenderName
 
                Next
 
    Set objApp = Nothing
    Set obj_ns = Nothing
    Set obj_CurrentOlkFolder = Nothing
    Set objItem = Nothing
 
End Sub

Select allOpen in new window

remove

On Error GoTo err_att

eghtebas,

I tried the code you posted.

I get a message stating a program is trying to access addresses and if I want to allow.

If I click yes, the form does display a portion of my outlook window but this locks my machine

irudyk,

I tried the code you posted.

I get an error saying object not found when access executes the following line of code

Set olFolder = olMailbox.Folders("Inbox")

Hmm, not sure how you could get an error message on that line when just prior to that line I have an On Error Resume Next (i.e. which practically means to ignore any error)?

Have you tried to copy and paste the code in a new/blank database file and run it from there just to rule out that it might be some other issue within your existing database file?

jrudyk

Appreciate the suggestion

For some reason it was indeed an issue with my database.

Thanks everyone fro the posts.   Between these posts and some other research I did, I managed to piece together the solution I needed.  Hope you don't mind that I'm splitting the points

For future reference here is the code:

(Note: The form has a different command button for each mailbox/profile I needed.  for space sake I only included the code for one of the command buttons.  The attached file shows an example of my mailbox structure and a snippet of the output file)

Option Compare Database

Dim MY_FOLDER
Dim MY_PROFILE

Private Const MY_PROFILE_PASSWORD =  Set this to the mailbox password

Dim objCDO
Dim objRootFolder
Dim objFolder
Dim objInfoStore
Dim datTriggerDateNewest
Dim datTriggerDateOldest
Dim intProcessedMessages


Private Sub cmdNEContact_Click()

'Script cycles through all Messages in an Outlook Store


MY_FOLDER = "set this to mailbox name"
MY_PROFILE = "set this to profile name"

Open "C:\NEContactMailInfo.txt" For Output As #1

Set objCDO = CreateObject("MAPI.Session")
objCDO.Logon MY_PROFILE, MY_PROFILE_PASSWORD
If GetRootFolder(MY_FOLDER) Then
    Set objRootFolder = objInfoStore.RootFolder
    For Each objFolder In objRootFolder.Folders
        ProcessFolder objFolder
    Next
End If
objCDO.Logoff
Set objFolder = Nothing
Set objRootFolder = Nothing
Set objInfoStore = Nothing
Set objCDO = Nothing

MsgBox "C:\NEContactMailInfo.txt created."

Close #1

End Sub

Function GetRootFolder(strFolderName)
    GetRootFolder = False
    For Each objInfoStore In objCDO.InfoStores
        If objInfoStore.Name = strFolderName Then
            GetRootFolder = True
            Exit For
        End If
    Next
End Function

Sub ProcessFolder(objFolder)
    Dim objSubFolders
    Dim objSubFolder
    Dim objMessages
    Dim objMessage
    Dim arrCategories()
    Dim intCatItem
   
    Dim OwnerName
   
   
    On Error Resume Next
       
   
    If objFolder.Folders.Count > 0 Then
        Set objSubFolders = objFolder.Folders
        For Each objSubFolder In objSubFolders
       
               
       
             Print #1, vbCrLf & vbCrLf & objFolder.Name & " - Owner# " & objSubFolder.Name & " has " & objSubFolder.Messages.Count & " messages" & vbCrLf
            'MsgBox (objFolder.Name & " - Owner# " & objSubFolder.Name & " has " & objSubFolder.Messages.Count & " messages")
           
               If objSubFolder.Messages.Count > 0 Then
                    Set objMessages = objSubFolder.Messages
                    For Each objMessage In objMessages
                        Print #1, "       " & objMessage.Subject & " " & objMessage.TimeReceived & vbCrLf
                    Next
                End If
            ProcessFolder objSubFolder
        Next
    End If
    Set objFolder = Nothing
    Set objSubFolders = Nothing
    Set objMessage = Nothing
    Set objMessages = Nothing
End Sub

listing.doc

johnnyg123,

Sorry for not being able to get back to you sooner.

re:> I get an error saying object not found when access executes the following line of code

If not added yet, you need to add the following reference:

Microsoft Outlook 11.0 Object Library

Good luck with your project.

Mike