Change the Outlook folder that a linked table in Acccess is pointing to using VBA

45 Views Asked by At

I have an Access 365 application with a linked table containing emails from a given Outlook folder. I want the user to be able to change the folder that this linked table is connected to from within the application. My code opens the TableDef and changes the .Connect property to the new connection string.

However when I run tdf.RefreshLink I get error 3011: The Microsoft Access database engine could not find the object 'Outlook_Emails'.

My code is as follows:

Dim olApp As Outlook.Application
Dim olSession As Outlook.Namespace
Dim olStartFolder As Outlook.Folder

Dim db As DAO.Database

Dim strConnect As String
Dim strMAPILEVEL As String
Dim strTABLE As String
Dim strFolderPath As String
Dim intSplit1 As Integer
Dim intSplit2 As Integer
Dim tdf As DAO.TableDef

Set db = CurrentDb
Set olApp = New Outlook.Application
Set olSession = olApp.GetNamespace("MAPI")

'Pick folder to link to
Set olStartFolder = olSession.PickFolder

'Check to make sure user didn't cancel PickFolder dialog.
If Not (olStartFolder Is Nothing) Then
    'Check Selected folder is a Mail folder
    If olStartFolder.DefaultItemType <> 0 Then
        MsgBox "not a mail folder"
        Exit Sub
    End If
    
    'Relink Outlook table to that folder
    Set tdf = db.TableDefs("Outlook_Emails")
    
    'generate new Connect string
    strFolderPath = olStartFolder.FolderPath
    intSplit1 = InStrRev(strFolderPath, "\", , vbTextCompare)
    strTABLE = Mid(strFolderPath, intSplit1 + 1)
    
    strMAPILEVEL = Mid(strFolderPath, 3, intSplit1 - 3)
    intSplit2 = InStr(strMAPILEVEL, "\")
    strMAPILEVEL = Left(strMAPILEVEL, intSplit2 - 1) & "|" & Mid(strMAPILEVEL, intSplit2) & "\"
    
    strConnect = "Outlook 9.0;MAPILEVEL=" & strMAPILEVEL & ";PROFILE=Outlook;TABLETYPE=0;TABLENAME=" & strTABLE & ";COLSETVERSION=12.0;DATABASE=C:\Users\" & Environ("USERNAME") & "\AppData\Local\Temp\;TABLE=" & strTABLE
    
    tdf.Connect = strConnect
    tdf.RefreshLink
End If

Thanks as always for any help,

Jim

0

There are 0 best solutions below