Linked Outlook Tables

[Thales750]

Hey Y'all,
There seems to be no end to the limit to the missing data in the linked Outlook tables.

Is there anyway to get the Primary Key? I'm guessing no.

Is there anyway to get the email address to be included in the "From Field" of the "Sender Name" These fields are identical and they both only resolve the Senders Name, not email address.

Any input will be welcome and appreciated.

 

[sxschech]

I ended up using a different approach because there were fields I wanted that didn't seem to be included when linking to outlook, or I didn't know how to add them to the list. I'm using a recordset to pull in the data, of course the downside of this is that it won't be a live link, and I had to put a button on my form to 'Refresh' the data and use vba code to edit outlook data.

Public Sub ReadInbox()
'http://www.blueclaw-db.com/read_email_access_outlook.htm
'https://stackoverflow.com/questions/19184650/late-binding-to-open-outlook-from-access
'https://www.mrexcel.com/forum/excel-questions/825511-vba-deal-outlook-do-items-office-2010-a.html
'20180718
'Added ReceivedDate to enable sorting to display
'same as it is shown in outlook.  Previously was
'sorting by SentDate
'20180926
'Added code to count attachments that are not embeded in the email body
'so the Has Attachment indicator on the form will only show as TRUE if
'there are regular attachment and will exclude logos and signatures by
'adding PR_ATTACHMENT_HIDDEN to filter out embeded attachments
'http://www.vbaexpress.com/forum/showthread.php?58494-Outlook-Attachments
'20181025
    Dim TempRst As DAO.Recordset
    Dim rst As DAO.Recordset
    'Dim OlApp As Outlook.Application   'Early
    Dim OlApp As Object                 'Late
    Dim olFolderInbox As Object
    Dim Inbox As Object
    Dim InboxItems As Object
    Dim Mailobject As Object
    Dim db As DAO.Database
    Dim dealer As Integer
    Dim stLink As String
    
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
Dim olkPA As Object 'propertyAccessor
Dim InboxAttachment As Object
Dim intAttachmentCount As Integer
    
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Delete * from tbloutlooktemp"
    DoCmd.SetWarnings True
    Set db = CurrentDb
    
    'Set OlApp = CreateObject("Outlook.Application")    'Outlook Not Running
    On Error Resume Next
    Set OlApp = GetObject(, "Outlook.Application")      'Outlook Running
    If Err.Number <> 0 Then
        Err.Clear
        Set OlApp = CreateObject("Outlook.Application")
    End If
    '''''''''''''''''''''''''''''''''''''''''''''
    '
    'Shared Folder
    'https://stackoverflow.com/questions/9076634/get-reference-to-additional-inbox
    'METHOD 1:
'    Dim olNS As NameSpace
'    Dim InputFolder As Outlook.MAPIFolder
'    Set olNS = Outlook.Application.GetNamespace("MAPI")
'
'    ' Get reference to folder in users Mailbox for Input
'    Set InputFolder = olNS.Folders("Procurement, Request").Folders("Inbox")
'
'    ' all the emails in the shared inbox are represented by:
'    InputFolder.Items
    
    'METHOD 2:
    'Use Namespace.GetSharedDefaultFolder. It will work even if the mailbox is not opened in the current profile.
    'You still need to have the right to open the mailbox and access the folder in question of course:

'    Set vNamespace = Application.GetNamespace("MAPI")
'    Set vRecipient = vNamespace.CreateRecipient("Procurement, Request")
'    If vRecipient.Resolve Then
'        Set vFolder = vNamespace.GetSharedDefaultFolder(vRecipient, olFolderInbox)
'    End If
'    'If you need to open the other user's mailbox (with all off its folders),
'    'you can use Redemption and its RDOSession.GetSharedMailbox method:
'
'    Set Session = CreateObject("Redemption.RDOSession")
'    Session.MAPIOBJECT = Application.Session.MAPIOBJECT
'    Set Store = Session.GetSharedMailbox("Procurement, Request")
'    Set vFolder = Store.GetDefaultFolder(olFolderInbox)
'    MsgBox "The address of the mailbox owner: " & Store.Owner.Address
    '
    '''''''''''''''''''''''''''''''''''''''''''''
    
    'MyInbox
    Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
    
    'Doc Control Inbox
    'commented out are other folders, used to test that can obtain data
    'from folders other than inbox and also include spaces in the folder name
    Set Inbox = OlApp.GetNamespace("Mapi").Folders("Doc Control").Folders("Inbox") 'Processed Emails") 'Pending Emails)
    
    Set TempRst = CurrentDb.OpenRecordset("tblOutlookTemp")
    '
    Set InboxItems = Inbox.Items
Set InboxAttachment = Mailobject.Attachment
    '
    For Each Mailobject In InboxItems
        'Exclude earlier messages
        If Mailobject.senton > #10/1/2018# Then
            With TempRst
                .AddNew
                !Subject = Mailobject.Subject
                !SentFrom = Mailobject.SenderName
                !SentFromAddress = Mailobject.SenderEmailAddress
                !SentTo = Mailobject.To
                !cc = Mailobject.cc
                !body = Mailobject.body
                stLink = middlebit("<", ">", Mailobject.body)
                !aconexlink = stLink
'--------------------------------------------------
'Determine if is "real" attachment, don't count
'embeded files as attachments as no need to save
'logos and signature graphic files
For Each InboxAttachment In Mailobject.Attachments
Set olkPA = InboxAttachment.propertyAccessor
If olkPA.GetProperty(PR_ATTACHMENT_HIDDEN) = False Then
intAttachmentCount = intAttachmentCount + 1
End If
Set InboxAttachment = Nothing
Next
'--------------------------------------------------
                !HasAttachments = intAttachmentCount 'Mailobject.Attachments.Count '(Commented out version counts attachment regardless of external or embeded)
                !DateReceived = Mailobject.ReceivedTime
                !DateSent = Mailobject.senton
                !Categories = Mailobject.Categories
                !flagstatus = Mailobject.flagstatus
                !Actions = Mailobject.flagstatus
                .Update
                Mailobject.unread = False
intAttachmentCount = 0
            End With
        End If
    Next

Finished:
    Set OlApp = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
    Set TempRst = Nothing

End Sub