1

With this bit of VBA code in MS Access I'm getting an error if its executed too often. The only way I've found to clear it is reboot my computer. Any idea why and what can I do?

enter image description here

Public Function HasOutlookAcct(strEmail As String) As Boolean
Dim OutMail As Object
Dim OutApp As OutLook.Application
Dim objNs As OutLook.NameSpace
Dim objAcc As Object

'https://stackoverflow.com/questions/67284852/outlook-vba-select-sender-account-when-new-email-is-created

Set OutApp = CreateObject("Outlook.Application")
Set objNs = OutApp.GetNamespace("MAPI")

For Each objAcc In objNs.Accounts
    If objAcc.SmtpAddress = strEmail Then
        HasOutlookAcct = True
        Exit For
    End If
Next

OutApp.Quit
Set objAcc = Nothing
Set objNs = Nothing

End Function
Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
Kwixster
  • 51
  • 8
  • 1
    Depending on your organization size, you may be looping thousands of accounts, that is rather wasteful. Try something like this: https://stackoverflow.com/questions/61340561/outlook-vba-function-to-retrieve-display-name-of-an-email-address – Andre Oct 31 '22 at 23:48
  • https://social.technet.microsoft.com/Forums/en-US/415f03fe-9ac2-4ab6-8df5-20b725c97cc6/re-running-out-of-shared-resources-in-outlook-2016?forum=outlook gives instructions for increasing the cache size. – david Oct 31 '22 at 23:56
  • The total size of the organization, including me, is 1. But I'm writing this app for a division within a company of thousands. Thanks, Andre – Kwixster Nov 01 '22 at 04:22
  • I will try increasing the resources for Outlook. But why would a program that basically sends text over the internet require so much memory? A case of bloated MS tech? Sorry for the rant. I've never been a fan of Outlook. Thanks, david. – Kwixster Nov 01 '22 at 04:26
  • [Edit](https://stackoverflow.com/posts/74269722/edit) the post to put in code that calls the function and reproduces the behaviour described. [How to create a Minimal, Complete, and Verifiable example](https://stackoverflow.com/help/mcve) – niton Nov 01 '22 at 12:38
  • 1
    [Please do not upload images of code/data/errors when asking a question.](//meta.stackoverflow.com/q/285551) – Ken White Nov 01 '22 at 23:12

2 Answers2

1

The code looks good. The NameSpace.Accounts property returns an Accounts collection object that represents all the Account objects in the current profile. I don't see any extensive or heavy usage of the Outlook object model, but creating a new Outlook Application instance in the method for checking whether a particular account is configured in Outlook or not is not the best way of using Outlook. Instead, I'd recommend running Outlook once at some point and getting all the configured emails for saving for future usage where necessary.

Also it makes sense to disable all COM add-ins to see whether it helps or not. The problem may be related to any specific COM add-in.

Eugene Astafiev
  • 47,483
  • 3
  • 24
  • 45
0

Appears the error is addressed by considering the user.

The assumption, based on my results, is Outlook is not cleaned up completely when the user's instance is closed with outApp.Quit.

When Outlook is open, outApp.Quit is not applied and Outlook remains open at the end.

When Outlook is not open, it is opened in the background and later closed with outApp.Quit.

There is zero or one instance of Outlook at any time.

Option Explicit


Public Function HasOutlookAcct(strEmail As String) As Boolean

'Reference Outlook nn.n Object Library
' Consistent early binding
Dim outApp As Outlook.Application
Dim objNs As Outlook.Namespace
Dim objAcc As Outlook.Account

Dim bCreated As Boolean

On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
On Error GoTo 0

If outApp Is Nothing Then
    bCreated = True
    Set outApp = CreateObject("Outlook.Application")
End If

Set objNs = outApp.GetNamespace("MAPI")

For Each objAcc In objNs.Accounts
    'Debug.Print objAcc.SmtpAddress
    
    If objAcc.SmtpAddress = strEmail Then
        HasOutlookAcct = True
        Exit For
    End If
    
    'Set objAcc = Nothing    ' Additional cleanup if needed
    
Next

If bCreated = True Then     ' Outlook object had to be created
    outApp.Quit
End If

'Set outApp = Nothing        ' Additional cleanup if needed
Set objNs = Nothing

End Function


Private Sub HasOutlookAcct_Test()

Dim x As Boolean
Dim sEmail As String

sEmail = "someone@somewhere.com"

Dim i As Long

For i = 1 To 50
    Debug.Print i & ": " & sEmail
    x = HasOutlookAcct(sEmail)
    Debug.Print " HasOutlookAcct: " & x
    DoEvents
Next

Debug.Print "done"

End Sub
niton
  • 8,771
  • 21
  • 32
  • 52