Import E-Mails from Outlook to Access, and read them from Access?

Hi RobDog,

I am reviving this thread since I have a question about this code.

I'm not going to lie, I am a complete NEWB when it comes to linking MS apps. And since you are a GOD when it comes to this stuff, I am going to ask some very newb questions about the code you have posted. (So please go easy on me ;) )

I have added the code above (the code with the 3 parts to it) to a module in Outlook. There in lies my first question - where do I place this code? The Form_Open() sub makes me think that the code should be placed in a form module, if not what does it refer to? At any rate, I have tried the code in both a module and form code and have come across this error: "Run-time eorr 3709: The connection cannot be used to perform this operation. It is either closed or invalid in this context."
This refers to this line of code:

VB Code:

goRs.Open sSQL, CnnA, adOpenKeyset, adLockOptimistic, adCmdText

I have set the following references set:
- VBA
- MS Outlook 11.0 Object Library
- OLE
- MS Office 11.0 Object Library
- MS Forms 2.0 Obj Library
- MS ADO (multi-dim) 2.8 Library
- MS ADO 2.0 Library

I tried to set more ADO Libraries but I would get a "Name conflicts with existing module, project, or object library" Error. Are there any other references that I need to set?

Any idea why the code is not working??
As always, your help is very much appreciated!!

In order to get a better picture, why do you have OLE and MS Forms? Are you doing this in VB6 or in Outlook VBA or Access?

To be honest, I'm not really sure why I have those references set. In fact, I'm pretty sure those may have been already set when I checked the references list.

To answer your question, I am doing this in Outlook VBA. I think I should be putting the Form_Load sub into an Access form that shows the inbox email... is that right? I do have a table called [Inbox]. Is there anything else i am missing?

I tried adding the Form_Load sub into a form in Access and it complained about the Set oApp = New Outlook.Application as if it doesn't understand what Outlook.Application is.

Maybe I should give you a little insight into what I am doing. I have a database that tracks engineering Issues. My end goal is allow the user to add issues to the database through Outlook. I guess a way to implement this would be to have an email open in Outlook and then click a button to export the email to the database (I already have a menubar button added thanks to your other code - and don't worry, you have TONS of props in my code!!!!) The fields that I would need to use would be the header info (from, to, time, etc.) and then the body and subject of the email. All of this would be used to create a new issue in the database. if there are any attachments in the email, they also need to be accessed from the database (which you have already addressed in this thread).

The reason I am asking you all of these questions about your code is so that I can understand how you are implementing it and then customize it for my specific project. But if you would like to help me out with that, I won't be complaining one bit ;) !! Thanks for the help in advance, you always play such a huge role in getting everyone's code in working order - and it doesn't go unnoticed!!

So here's a little more clarification... the references I was referring to were my Outlook references. I now have set my Access references to include Outlook Object Library.

Now, I have included the Form_Load sub into my Access VBA (which is what I think I'm supposed to do, but I'm not sure). This is what I added to my [Form_Import from Outlook TEST] code:

VB Code:

Option Compare Database
Private oApp As Outlook.Application
Private oNS As Outlook.NameSpace
Private oInbox As Outlook.MAPIFolder
Private oTasks As Outlook.MAPIFolder
Private CnnA As ADODB.Connection
 
Private Sub Form_Load()
 
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oInbox = oNS.GetDefaultFolder(olFolderInbox)
    Set oTasks = oNS.GetDefaultFolder(olFolderTasks)
    'MUST BE A FOLDER WITH A DEFAULT MESSAGE TYPE OF POST!!!
    'RIGHT CLICK ON THE DESIRED NEW FOLDER AND CLICK PROPERTIES.
    'THEN LOOK AT THE BOTTON AND IT SHOULD SAY -
    '"WHEN POSTING TO THIS FOLDER, USE: POST"
'    Set oInbox = oNS.Folders("Your Custom Folder Name Here!")
    
    Set CnnA = New ADODB.Connection
    CnnA.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txtDBPath & ";Persist Security Info=False"
    CnnA.Open
    
End Sub

When the code gets to the last line (CnnA.Open) it give me the "Authentication Failed" error. Any ideas?

So now if I can figure out why the Connection is being refused, that will get rid of my first error in Outlook (the 3709 run-time error)

This is a two part issue. First part is to export the emails to the Access table. This is done in the Outlook VBA code part. Then to read/view tehm you need to do it from Access.

So first part you will need a reference to MS ADO 2.x Object Library.

Second part you need a reference to MS Outlook xx.0 Object Library

Now to throw a wrench in the works, do your users need a real time listing of the emails in Access to match whats in Outlook?

I think I wil split this off to a new thread referencing this one. ;)

Thread split from this one located here - http://www.vbforums.com/showthread.php?t=264040

:)


The issue is probably from the connectionstring not being completely correct as it had a textbox in it which you probably dont need. Just hard code in the db path or use Application.Path.

Alright, I am an idiot (as if you didn't already figure that out). I had to replace the txtDBPath (duhhhhhh). Well, I did that and then I attempt to run the Outlook_Emails_2_Access sub (in Outlook), I get the "Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another" when I get to this line:

VB Code:

goRs.Open sSQL, CnnA, adOpenKeyset, adLockOptimistic, adCmdText

Whats your sSQL look like?

Sorry I split the thread like that, I'm not entirely sure how I even did it!! Anyway, I posted a reply on that thread. Thanks robdog!

VB Code:

sSQL = "SELECT * FROM [Inbox] WHERE 1=2;"

I did that split as to keep the thread starters issue on topic and created a new thread just for yours.

This is the thread to post in now. ;)

Do you have a table called Inbox in Access?

Alright, I am an idiot (as if you didn't already figure that out). I had to replace the txtDBPath (duhhhhhh). Well, I did that and then I attempt to run the Outlook_Emails_2_Access sub (in Outlook), I get the "Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another" when I get to this line:

VB Code:

goRs.Open sSQL, CnnA, adOpenKeyset, adLockOptimistic, adCmdText

To answer your first question, the listing of emails in Access only needs to be the emails that pertain to each issue, it does not need to match ALL of the emails in Outlook. So for example, I have an Issues table that contains all of my issues. There is a "Comments" field in the table in which i want the body of the email from Outlook to go to. I would then like to include the attachments (somehow - I guess I can add a combobox to my form like you said earlier in the thread).

So when the user opens up an email (from Outlook) that contains an engineering issue, they can then click a button and the contents of the email will be added as a new record in the Issues table. I can list out all of the fields of the issue table if you want me to.

To answer your second question, yes I do have a table in Access named [Inbox].

Ok, to refresh my memory and make sure we are talking about the same part, your in access trying to connect to the Outlook Inbox with the goRs object?

You see there are two possible ways to connect to Outlook from Access. One is using ADO and the other is using the Outlook Object Model.

Which part are you wanting to start on first and we will go from there.

I'll detail it out a little (sorry for the confusion... i am confusing myself so I'm sure its not easy for you either!!)

In access, I have a formed called "Import from Outlook TEST." For the Form_Load event on that form I have the following code (which executes with NO errors):

VB Code:

Option Compare Database
Private oApp As Outlook.Application
Private oNS As Outlook.NameSpace
Private oInbox As Outlook.MAPIFolder
Private oTasks As Outlook.MAPIFolder
Private CnnA As ADODB.Connection
 
Private Sub Form_Load()
 
    Set oApp = New Outlook.Application
    Set oNS = oApp.GetNamespace("MAPI")
    Set oInbox = oNS.GetDefaultFolder(olFolderInbox)
    Set oTasks = oNS.GetDefaultFolder(olFolderTasks)
    'MUST BE A FOLDER WITH A DEFAULT MESSAGE TYPE OF POST!!!
    'RIGHT CLICK ON THE DESIRED NEW FOLDER AND CLICK PROPERTIES.
    'THEN LOOK AT THE BOTTON AND IT SHOULD SAY -
    '"WHEN POSTING TO THIS FOLDER, USE: POST"
'    Set oInbox = oNS.Folders("Your Custom Folder Name Here!")
    
    Set CnnA = New ADODB.Connection
    CnnA.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\Documents and Settings\edmastro.AMR\My Documents\Issues Database.mdb" & "; Persist Security Info=False"
    CnnA.Open
    
End Sub

(Rest of code posted on new reply due to length)

Then, in Outlook, I have a module that contains the rest of the code (activated by a button click) Here is the rest of the code:

VB Code:

'Option Explicit
 
'Private oApp As Outlook.Application
'Private oNS As Outlook.NameSpace
'Private oInbox As Outlook.MAPIFolder
'Private oTasks As Outlook.MAPIFolder
'Private CnnA As ADODB.Connection
 
Private Sub cmdExportEmails_Click()
 
    Call Outlook_Emails_2_Access
 
End Sub
 
'Private Sub Form_Load()
'
 '   Set oApp = New Outlook.Application
  '  Set oNS = oApp.GetNamespace("MAPI")
   ' Set oInbox = oNS.GetDefaultFolder(olFolderInbox)
    'Set oTasks = oNS.GetDefaultFolder(olFolderTasks)
    'MUST BE A FOLDER WITH A DEFAULT MESSAGE TYPE OF POST!!!
    'RIGHT CLICK ON THE DESIRED NEW FOLDER AND CLICK PROPERTIES.
    'THEN LOOK AT THE BOTTON AND IT SHOULD SAY -
    '"WHEN POSTING TO THIS FOLDER, USE: POST"
'    Set oInbox = oNS.Folders("Your Custom Folder Name Here!")
    
    'Set CnnA = New ADODB.Connection
    'CnnA.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & txtDBPath & ";Persist Security Info=False"
    'CnnA.Open
    
'End Sub
 
Private Function Outlook_Emails_2_Access()
'   <GORS = ACCESS>
    On Error GoTo No_Bugs
 
    Dim goRs As ADODB.Recordset
    
    Dim oEmail As Outlook.MailItem
    Dim oMeetingType As Outlook.MeetingItem
    Dim oDistributionList As Outlook.DistListItem
    
    Dim vType As Variant
    
    Dim i As Integer
    Dim ii As Integer
    
    Dim sAttachment As String
    
    Dim sSQL As String
    
    Set goRs = New ADODB.Recordset
    
    sSQL = "SELECT * FROM [Inbox] WHERE 1=2;"
    goRs.Open sSQL, CnnA, adOpenKeyset, adLockOptimistic, adCmdText
    
    prbProgress.Max = oInbox.Items.Count
    i = 1
    Do While i <= oInbox.Items.Count
        DoEvents
        Select Case oInbox.Items(i).Class
            Case olMail
                vType = "Email"
            Case olMeetingRequest
                vType = "MeetingItem"
            Case olMeetingResponseNegative
                vType = "MeetingItem"
            Case olMeetingResponsePositive
                vType = "MeetingItem"
            Case olMeetingResponseTentative
                vType = "MeetingItem"
            Case olDistributionList
                vType = "DistListItem"
        End Select
        If vType = "Email" Then 'ONLY EMAIL TYPES
            Set oEmail = oInbox.Items(i)
            If FindOutlookEmail(oEmail.EntryID) = False Then
                'ADDED FOR TESTING ONLY SO YOU CAN SEE HOW TO PASS THE ITEMS.
                'TAKE OUT AND PLACE WHERE YOU ARE CALLING IT FROM
                'OTHERWISE IT WILL OPEN ALL EXPORTED EMAILS
                Call OpenOutlookEmail(oEmail.EntryID, CStr(oInbox.Items(i).Class))
                goRs.AddNew
                goRs!To = oEmail.To
                goRs!CC = oEmail.CC
                goRs!BCC = oEmail.BCC
                goRs!Subject = oEmail.Subject
                goRs!Body = oEmail.Body           'PLAIN TEXT BODY NOTES
                goRs!HTMLBody = oEmail.HTMLBody   'HTML BODY NOTES
                goRs!Importance = oEmail.Importance
                goRs!Received = oEmail.ReceivedTime
                goRs!Class = oEmail.Class 'EMAIL, MEETING RESPONSE, MEETING REQUEST, DIST. LIST, ETC.
                goRs!ReceivedByName = oEmail.ReceivedByName
                goRs!EntryID = oEmail.EntryID
                If oEmail.Attachments.Count > 1 Then
                    'LOOP THROUGH ALL ATTACHMENTS SAVING TO DIRECTORY AND ENTERING FILENAME INTO FIELD
                    For ii = 1 To oEmail.Attachments.Count
                        'DETERMINE ATTACHMENT CLASS TYPE ATTACHED, LINKED, EMBEDDED, OR OLE
                        If oEmail.Attachments.Item(ii).Type = olByValue Or oEmail.Attachments.Item(ii).Type = olEmbeddeditem Then
                            oEmail.Attachments.Item(ii).SaveAsFile "C:\MyOutlookEmailExport\Attachments\" & oEmail.Attachments.Item(ii).FileName
                            sAttachment = sAttachment & "C:\MyOutlookEmailExport\Attachments\" & oEmail.Attachments.Item(ii).FileName & vbNewLine
                        End If
                    Next
                    goRs!Attachment = sAttachment
                Else
                    goRs!Attachment = "None"
                End If
                'CONTINUE ON WITH OTHER FIELD YOU WANT
                '...
                goRs.Update
            End If
            Set oEmail = Nothing
        ElseIf vType = "MeetingItem" Then
            Set oMeetingType = oInbox.Items(i)
            If FindOutlookEmail(oMeetingType.EntryID) = False Then
                goRs.AddNew
                goRs!To = oMeetingType.Recipients.Item(1).Name
                goRs!CC = IIf(oMeetingType.Recipients.Count > 1, oMeetingType.Recipients.Item(2).Name, "")
                goRs!BCC = ""
                goRs!Subject = oMeetingType.Subject
                goRs!Body = oMeetingType.Body           'PLAIN TEXT BODY NOTES
                goRs!HTMLBody = ""
                goRs!Importance = oMeetingType.Importance
                goRs!Received = oMeetingType.ReceivedTime
                goRs!Class = oMeetingType.Class 'EMAIL, MEETING RESPONSE, MEETING REQUEST, DIST. LIST, ETC.
                goRs!ReceivedByName = ""
                goRs!EntryID = oMeetingType.EntryID
                If oMeetingType.Attachments.Count > 1 Then
                    'LOOP THROUGH ALL ATTACHMENTS SAVING TO DIRECTORY AND ENTERING FILENAME INTO FIELD
                    For ii = 1 To oMeetingType.Attachments.Count
                        'DETERMINE ATTACHMENT CLASS TYPE ATTACHED, LINKED, EMBEDDED, OR OLE
                        If oMeetingType.Attachments.Item(ii).Type = olByValue Or oMeetingType.Attachments.Item(ii).Type = olEmbeddeditem Then
                            oMeetingType.Attachments.Item(ii).SaveAsFile "C:\MyOutlookEmailExport\Attachments\" & oMeetingType.Attachments.Item(ii).FileName
                            sAttachment = sAttachment & "C:\MyOutlookEmailExport\Attachments\" & oMeetingType.Attachments.Item(ii).FileName & vbNewLine
                        End If
                    Next
                    goRs!Attachment = sAttachment
                Else
                    goRs!Attachment = "None"
                End If
                'CONTINUE ON WITH OTHER FIELD YOU WANT
                '...
                goRs.Update
            End If
            Set oMeetingType = Nothing
        ElseIf vType = "DistListItem" Then
            Set oDistributionList = oInbox.Items(i)
            If FindOutlookEmail(oDistributionList.EntryID) = False Then
                goRs.AddNew
                goRs!To = oDistributionList.DLName
                goRs!CC = oDistributionList.MemberCount & "-Members"
                goRs!BCC = ""
                goRs!Subject = oDistributionList.Subject
                goRs!Body = oDistributionList.Body           'PLAIN TEXT BODY NOTES
                goRs!HTMLBody = ""
                goRs!Importance = oDistributionList.Importance
                goRs!Received = ""
                goRs!Class = oDistributionList.Class 'EMAIL, MEETING RESPONSE, MEETING REQUEST, DIST. LIST, ETC.
                goRs!ReceivedByName = ""
                goRs!EntryID = oDistributionList.EntryID
                If oDistributionList.Attachments.Count > 1 Then
                    'LOOP THROUGH ALL ATTACHMENTS SAVING TO DIRECTORY AND ENTERING FILENAME INTO FIELD
                    For ii = 1 To oDistributionList.Attachments.Count
                        'DETERMINE ATTACHMENT CLASS TYPE ATTACHED, LINKED, EMBEDDED, OR OLE
                        If oDistributionList.Attachments.Item(ii).Type = olByValue Or oDistributionList.Attachments.Item(ii).Type = olEmbeddeditem Then
                            oDistributionList.Attachments.Item(ii).SaveAsFile "C:\MyOutlookEmailExport\Attachments\" & oDistributionList.Attachments.Item(ii).FileName
                            sAttachment = sAttachment & "C:\MyOutlookEmailExport\Attachments\" & oDistributionList.Attachments.Item(ii).FileName & vbNewLine
                        End If
                    Next
                    goRs!Attachment = sAttachment
                Else
                    goRs!Attachment = "None"
                End If
                'CONTINUE ON WITH OTHER FIELD YOU WANT
                '...
                goRs.Update
            End If
            Set oDistributionList = Nothing
        Else
            MsgBox "Unsupported message type!", vbOKOnly + vbExclamation
        End If
        Set oEmail = Nothing
        prbProgress.Value = i
        i = i + 1
    Loop
    
    Set oInbox = Nothing
    Set oNS = Nothing
    goRs.Close
    Set CnnA = Nothing
    Set goRs = Nothing
    Exit Function
 
No_Bugs:
    
    MsgBox Err.Number & "-" & Err.Description, vbCritical, "Outlook Email Export"
    Resume
 
End Function
 
''''''''''2nd 3rd
 
Private Function FindOutlookEmail(ByVal oEmailEntryID As String) As Boolean
 
    Dim oRsAccessEmail As ADODB.Recordset 'EMAIL IN ACCESS TO CHECK AGAINST
    
    Dim i As Integer
    
    Set oRsAccessEmail = New ADODB.Recordset
    oRsAccessEmail.Open "SELECT EntryID FROM Inbox WHERE EntryID = '" & oEmailEntryID & "';", CnnA, adOpenKeyset, adLockReadOnly, adCmdText
    If oRsAccessEmail.BOF = True And oRsAccessEmail.EOF = True Then
        FindOutlookEmail = False
    Else
        FindOutlookEmail = True
    End If
    Set oRsAccessEmail = Nothing
 
End Function

continued....

Here's the rest:

VB Code:

Private Function OpenOutlookEmail(ByVal oEmailEntryID As String, sType As String)
'PASS THE .ENTRYID AND THE .TYPE PROPERTY OF THE OUTLOOK ITEM
    On Error GoTo No_Bugs
    
    Dim oOBJ As Object
    Dim oItem As Object
    Dim i As Integer
    Dim bFound As Boolean
    
    'CHECK EACH ITEMS ENTRYID PROPERTY FOR A MATCH (.FIND NOT COMPATIBLE WITH .ENTRYID PROPERTY)
    bFound = False
    For i = 1 To oInbox.Items.Count
        Set oItem = oInbox.Items(i)
        If oItem.EntryID = oEmailEntryID Then
            bFound = True
            Exit For
        Else
            bFound = False
        End If
        Set oItem = Nothing
    Next
    
    If bFound = True Then
        Select Case CLng(sType)
            Case olMail
                sType = "Email"
            Case olMeetingRequest, olMeetingResponseNegative, olMeetingResponsePositive, olMeetingResponseTentative
                sType = "MeetingItem"
            Case olDistributionList
                sType = "DistListItem"
            Case Else
                sType = ""
        End Select
        Select Case sType
            Case "Email", "MeetingItem", "DistListItem"
                Set oOBJ = oInbox.Items(i)
                If TypeName(oOBJ) <> "Nothing" Then
                    oOBJ.Display 'THE USE CAN MAKE CHANGES AND SAVE THEM TO OUTLOOK
                Else
                    MsgBox sType & " not found in Outlook!", vbOKOnly + vbExclamation
                End If
            Case Else
                MsgBox "Invalid Outlook Item Type Passed!", vbOKOnly + vbCritical
        End Select
    Else
        MsgBox "Item not found in Outlook!", vbOKOnly + vbInformation
    End If
    Exit Function
    
No_Bugs:
 
    MsgBox Err.Number & " = " & Err.Description, vbOKOnly + vbExclamation
    Exit Function
    Resume
End Function
 
'''''' 3rd 3rd
 
Private Function Outlook_Tasks_2_Access()
'   <GORS = ACCESS>
    On Error GoTo No_Bugs
 
    Dim goRs As ADODB.Recordset
    
    Dim oTask As Outlook.TaskItem
    Dim oTaskReqAccpt As Outlook.TaskRequestAcceptItem
    Dim oTaskReqDcln As Outlook.TaskRequestDeclineItem
    Dim oTaskReqItm As Outlook.TaskRequestItem
    Dim oTaskReqUpd As Outlook.TaskRequestUpdateItem
    
    Dim vType As Variant
    
    Dim i As Integer
    Dim ii As Integer
    Dim iii As Integer
    
    Dim sAttachment As String
    Dim sRecipients As String
    
    Dim sSQL As String
    
    Set goRs = New ADODB.Recordset
    
    sSQL = "SELECT * FROM [Tasks] WHERE 1=2;"
    goRs.Open sSQL, CnnA, adOpenKeyset, adLockOptimistic, adCmdText
    
    prbProgress.Max = oTasks.Items.Count
    i = 1
    Do While i <= oTasks.Items.Count
        DoEvents
        Select Case oTasks.Items(i).Class
            Case olTask
                vType = "Task"
            Case olTaskRequestAccept
                vType = "TaskReqAccpt"
            Case olTaskRequestDecline
                vType = "TaskReqDcln"
            Case olTaskRequest
                vType = "TaskReqItm"
            Case olTaskRequestUpdate
                vType = "TaskReqUpd"
        End Select
        If vType = "Task" Then 'ONLY TASK TYPES
            Set oTask = oTasks.Items(i)
            If FindOutlookTask(oTask.EntryID) = False Then
                'ADDED FOR TESTING ONLY SO YOU CAN SEE HOW TO PASS THE ITEMS.
                'TAKE OUT AND PLACE WHERE YOU ARE CALLING IT FROM
                'OTHERWISE IT WILL OPEN ALL EXPORTED TASKS
                Call OpenOutlookTask(oTask.EntryID, CStr(oTasks.Items(i).Class))
                goRs.AddNew
                goRs!To = oTask.Recipients.Item(0).Name
                sRecipients = ""
                For iii = 1 To oTask.Recipients.Count - 1
                    sRecipients = sRecipients & oTask.Recipients.Item(iii).Name & "; "
                Next
                goRs!CC = sRecipients
                goRs!Subject = oTask.Subject
                goRs!Body = oTask.Body           'PLAIN TEXT BODY NOTES
                goRs!Importance = oTask.Importance
                goRs!StartDate = oTask.StartDate
                goRs!Class = oTask.Class 'TASK, TASKREQUESTACCEPT, TASKREQUESTDECLINE, ETC.
                goRs!ReceivedByName = oTask.ReceivedByName
                goRs!EntryID = oTask.EntryID
                If oTask.Attachments.Count > 1 Then
                    'LOOP THROUGH ALL ATTACHMENTS SAVING TO DIRECTORY AND ENTERING FILENAME INTO FIELD
                    For ii = 1 To oTask.Attachments.Count
                        'DETERMINE ATTACHMENT CLASS TYPE ATTACHED, LINKED, EMBEDDED, OR OLE
                        If oTask.Attachments.Item(ii).Type = olByValue Or oTask.Attachments.Item(ii).Type = olEmbeddeditem Then
                            oTask.Attachments.Item(ii).SaveAsFile "C:\MyOutlookEmailExport\Attachments\" & oTask.Attachments.Item(ii).FileName
                            sAttachment = sAttachment & "C:\MyOutlookEmailExport\Attachments\" & oTask.Attachments.Item(ii).FileName & vbNewLine
                        End If
                    Next
                    goRs!Attachment = sAttachment
                Else
                    goRs!Attachment = "None"
                End If
                'CONTINUE ON WITH OTHER FIELD YOU WANT
                '...
                goRs.Update
            End If
            Set oTask = Nothing
        'MORE CODE GOES HERE FOLOWING SAME LOGIC
        'ElseIf
        
        'ElseIf
        'etc.
        End If
 
 
End Function
 
Private Function FindOutlookTask(ByVal oTaskEntryID As String) As Boolean
 
    Dim oRsAccessTask As ADODB.Recordset 'TASK IN ACCESS TO CHECK AGAINST
    
    Dim i As Integer
    
    Set oRsAccessTask = New ADODB.Recordset
    oRsAccessTask.Open "SELECT EntryID FROM Tasks WHERE EntryID = '" & oTaskEntryID & "';", CnnA, adOpenKeyset, adLockReadOnly, adCmdText
    If oRsAccessTask.BOF = True And oRsAccessTask.EOF = True Then
        FindOutlookTask = False
    Else
        FindOutlookTask = True
    End If
    Set oRsAccessTask = Nothing
 
End Function
Private Function OpenOutlookTask(ByVal oTaskEntryID As String, sType As String)
'PASS THE .ENTRYID AND THE .TYPE PROPERTY OF THE OUTLOOK ITEM
    On Error GoTo No_Bugs
    
    Dim oOBJ As Object
    Dim oItem As Object
    Dim i As Integer
    Dim bFound As Boolean
    
    'CHECK EACH ITEMS ENTRYID PROPERTY FOR A MATCH (.FIND NOT COMPATIBLE WITH .ENTRYID PROPERTY)
    bFound = False
    For i = 1 To oInbox.Items.Count
        Set oItem = oTasks.Items(i)
        If oItem.EntryID = oEmailEntryID Then
            bFound = True
            Exit For
        Else
            bFound = False
        End If
        Set oItem = Nothing
    Next
    
    If bFound = True Then
        Select Case CLng(sType)
            Case olTask
                sType = "Task"
            Case olTaskRequestAccept, olTaskRequestDecline, olTaskRequest, olTaskRequestUpdate
                sType = "TaskItem"
            Case Else
                sType = ""
        End Select
        Select Case sType
            Case "Task", "TaskItem"
                Set oOBJ = oTasks.Items(i)
                If TypeName(oOBJ) <> "Nothing" Then
                    oOBJ.Display 'THE USE CAN MAKE CHANGES AND SAVE THEM TO OUTLOOK
                Else
                    MsgBox sType & " not found in Outlook!", vbOKOnly + vbExclamation
                End If
            Case Else
                MsgBox "Invalid Outlook Item Type Passed!", vbOKOnly + vbCritical
        End Select
    Else
        MsgBox "Item not found in Outlook!", vbOKOnly + vbInformation
    End If
    Exit Function
    
No_Bugs:
 
    MsgBox Err.Number & " = " & Err.Description, vbOKOnly + vbExclamation
    Exit Function
    Resume
End Function

You dont need the tasks code since we are only going to be dealing with the inbox.

You know what, I think it would be easier to just start fresh. Also most of my code is for dealingwith the tasks folder too. ;)

haha, i'm really sorry for the trouble, robdog. I guess the reason I was trying to modify your old code is because I learn really well from example and that was absolutely the best example I could find anywhere!!

Starting from fresh sounds like a great way to learn too!!! :)

Ok, to start, my code example was using VB6 to interact with both Access and Outlook. If this is a possibility then we can reuse most of the code but if not then we will use parts of it placed in both Outlook and Access.

I can't use VB6 because VB6 is not loaded onto my company's OS build. I work for a corporation and they have their own OS build with apps, etc. Office is included, but VB6 is not.

Ok, no problem. Which version of Outlook and Access are we dealing with? All the same versions on all systems?

From Help -> About...

Microsoft Visual Basic 6.3
Version 9972
VBA: Retail 6.4.9972
Forms3: 11.0.6254

Yes, all the versions are the same.

That relates to Office 2003 but are you all updated with SP2?

Also, how does the import into Access need to occur? Do it from an open email and pull down a menu item to export it or select the email and then pull down a menu item from that mail Outlook interface. The second is easier. ;)

Yes, I do realize the second is easier and I already have the code you gave me a month ago or so that adds a toolbar button to the inspector window (thanks!!!). The button is under Tools -> Add to the AR Tracker... However, it would be *nice to have* the option to allow the user to have the email open. But this is not as important as getting the whole thing to work, which is my number 1 priority. After everything works, then I will see what i can do about adding a button to start this function from an opened email.

Sorry for not answering your first question... yes SP2 and all... IT pushes all updates immediately.

Crap... actually it seems they aren't pushing Office updates... here are the versions for Outlook and Access:

Outlook: 11.6359.6360 SP1
Access: 11.6355.6360 SP1

Sorry about that!

If there is something about SP2 that is easier to use, then I can make sure that everyone who uses this tracker tool will need to update the SP2. That shouldn't be a problem, so do whatever is easier for you.

No issues between sp1 and sp2 but just needing to know how to handle the references. Since we are all on the same version and latest one we can early bind but if there is ever an upgrade then all you have to do is change the reference to the new version. Early binding is easier to work with as it gives you intellisense popups.

If your saying that you have my code for the inspector window then that is an opened email. the close email will be an explorer window. Where are you at with this then?


Ps, sorry for the delays but I am multitasking on a project.

No worries on the delay, I know you're busy! Here is the code I have in ThisOutlookSession (this works for the explorer window)...

VB Code:

Option Explicit
'Behind ThisOutlookSession
Public WithEvents oMnuSaveAs As Office.CommandBarButton
 
Private Sub SyncMnuSaveAsButton(btn As Office.CommandBarButton)
    Set oMnuSaveAs = btn
    If btn Is Nothing Then
        MsgBox "Sync. of '" & btn.Caption & "' button event failed!", vbCritical + vbOKOnly
    End If
End Sub
 
Private Sub Application_MAPILogonComplete()
    
    Dim oCBmnuTools As Office.CommandBarPopup
    Dim oCBmnuSaveMe As Office.CommandBarButton
    
    '<ADD A MENU ITEM>
    Set oCBmnuTools = Application.ActiveExplorer.CommandBars("Menu Bar").Controls("&Tools")
    Set oCBmnuSaveMe = Application.ActiveExplorer.CommandBars("Menu Bar").FindControl(msoControlButton, 1, "888", True, True)
    If TypeName(oCBmnuSaveMe) = "Nothing" Then
        Set oCBmnuSaveMe = oCBmnuTools.Controls.Add(msoControlButton, 1, "888", , True)
    End If
    With oCBmnuSaveMe
        .BeginGroup = True
        .Caption = "Add to AR Tracker..."
        .Enabled = True
        .Style = msoControlCustom
        .Tag = "888"
        .Visible = True
    End With
    Call SyncMnuSaveAsButton(oCBmnuSaveMe)
    '</ADD A MENU ITEM>
End Sub
 
Private Sub oMnuSaveAs_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
''' Anything in this sub can be changed!! '''
    'Dim myExcel As Object
    MsgBox "booya!"
    'Set myExcel = CreateObject(Excel.Application)
    arInfo.Show
End Sub

If adding a button to an opened email is easier than this, then I would love for you to share how you did it, otherwise if it is more complicated, we can come back to that later, if needed.

Hey RobDog...

I've been working on some code just to get my head in the game as to how to connect the Access and Outlook objects (which really isn't that bad with VBA). I know this is probably horrible code (remember I just started learning Outlook/Excel VBA objects/methods) and I know it's not much, but at least its a start... I'm also trying to show you that I'm not relying on you to write code for me (although it would be nice! ;) ). Here it is:

VB Code:

Private Sub test()
    Dim ACobj As Access.Application
    Dim txtDBstring As String
    'Dim myRS As Access.Control
    'Dim myfolder As Outlook.MAPIFolder
    Dim myExplorers As Outlook.Explorer
    Dim myExpSel    As Outlook.Selection
    Dim myMailItem As Outlook.MailItem
    Dim myForm As Access.Form
   
    txtDBstring = "C:/Documents and Settings/edmastro.AMR/My Documents/Issue database.mdb"
    
    Set ACobj = GetObject("C:\Documents and Settings\edmastro.AMR\My Documents\Issues database.mdb", "Access.Application")
    'Set myfolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Set myExplorers = Application.ActiveExplorer
    Set myExpSel = myExplorers.Selection
    Set myMailItem = CreateItem(olMailItem)
    Set myForm = Access.Forms("Issues")
    
    ACobj.DoCmd.OpenForm ("Issues")
    ACobj.DoCmd.GoToRecord acDataForm, "Issues", acNewRec
    
    'myForm!Comments = "Booya!"
    
    If Not myExpSel.Item(1) Is Nothing Then
        myForm!Comments = myExpSel.Item(1).Body
    End If
    
    'If Application.ActiveExplorer.CurrentItem = "MailItem" Then MsgBox "mailitem"
    
    Set ACobj = Nothing
    Set myRS = Nothing
    Set myfolder = Nothing
    Set myExplorers = Nothing
    Set myExpSel = Nothing
    Set myMailItem = Nothing
    Set myForm = Nothing
End Sub

So where I'm stuck at right now is how to reference an Access form (myForm) and its controls from Outlook. I tried to access a Comments textbox in myFrom using "myForm!Comments" but that doesn't work. I want to set the comments textbox equal to the contents of the email (.body). Any ideas on how to reference the form and its controls from Outlook?

Try opening the form first and then setting your object variable to the item in the forms collection.

VB Code:

ACobj.DoCmd.OpenForm ("Issues")
Set myForm = Access.Forms("Issues")