Error 91 generated when trying to set .SendUsingAccount

I'm trying to send an email from MsAccess VBA. Everything works until I try to use a different account. Then I get error 91. There is lots of example code around and I can't see how what I have done differs.

The code (taken from an example from CARDA Consultants Inc 2007 and modified)

Function SendEmail(strTo As String, strSubject As String, strBody As String, bEdit As Boolean, _
                   Optional strBCC As Variant, Optional AttachmentPath As Variant)
    'Send Email using late binding to avoid reference issues
       Dim objOutlook As Outlook.Application '"as Object" if late binding
       Dim objOutlookMsg As Outlook.MailItem  ' "as Object" if late binding
       Dim objOutlookRecip As Object
       Dim objOutlookAttach As Object
       Dim objOlAccount As Outlook.account
       Dim I As Integer
     
       On Error GoTo ErrorMsgs
     
       Set objOutlook = CreateObject("Outlook.Application")
       Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
       Set objOlAccount = objOutlook.Session.accounts.Item(2)   '<<<<<< this does exist. Proved using debug
       
       With objOutlookMsg
          Set .SendUsingAccount = objOlAccount    '<<<<<< fails with error 91. If I comment this out then email is generated ok
          Set objOutlookRecip = .Recipients.Add(strTo)
          objOutlookRecip.Type = 1
          If Not IsMissing(strBCC) Then
            Set objOutlookRecip = .Recipients.Add(strBCC)
            objOutlookRecip.Type = 3
          End If
     
          .Subject = strSubject
          .Body = strBody
          .Importance = 2  'Importance Level  0=Low,1=Normal,2=High
     
          ' Add attachments to the message.
          If Not IsMissing(AttachmentPath) Then
            If IsArray(AttachmentPath) Then
               For I = LBound(AttachmentPath) To UBound(AttachmentPath) '- 1
                  If AttachmentPath(I) <> "" And AttachmentPath(I) <> "False" Then
                    Set objOutlookAttach = .Attachments.Add(AttachmentPath(I))
                  End If
               Next I
            Else
                If AttachmentPath <> "" Then
                    Set objOutlookAttach = .Attachments.Add(AttachmentPath)
                End If
            End If
          End If
     
          For Each objOutlookRecip In .Recipients
             If Not objOutlookRecip.Resolve Then
                objOutlookMsg.Display
             End If
          Next
     
          If bEdit Then 'Choose btw transparent/silent send and preview send
            .Display
          Else
            .Save  '.Send (save puts it in drafts, send puts it in outbox and sends it)
          End If
       End With
     
       Set objOutlookMsg = Nothing
       Set objOutlook = Nothing
       Set objOutlookRecip = Nothing
       Set objOutlookAttach = Nothing
       Set objOlAccount = Nothing
     
ErrorMsgs:
    MsgBox Err.Number & " - " & Err.Description
    Exit Function
End Function