Excel VBA code working except one computer - Error 91

Question

I have an Excel VBA sub that is used to search for contact details in Outlook.

The function is working on many computer except one that is the primary user of this function, on which it produces the error:

Error 91: Object variable or With block variable not set

Can someone help me please?

'Function to import Outlook contacts according to their client code
Sub ExportOutlookAddressBook()

Application.ScreenUpdating = False
    Dim olApp As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olAL As Outlook.AddressList
    Dim olEntry As Outlook.AddressEntry
    Dim CodeClient As String
    Dim RCompanyName As String
    Dim i As Integer
    Dim AccountCount As Integer

    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    CodeClient = 0
    RCompanyName = 0
    i = 0
    AccountCount = olNS.Accounts.Count
    Range("AA6:AF10").ClearContents
    For i = 1 To AccountCount
        Set olAL = olNS.AddressLists(i) 'Change name if different contacts list name
        Set olEntry = olAL.AddressEntries(1)
        ActiveWorkbook.ActiveSheet.Range("K6").Select
        CodeClient = ActiveCell.Value
        ActiveWorkbook.ActiveSheet.Range("AA6").Select

        For Each olEntry In olAL.AddressEntries
            ' your looping code here
            RCompanyName = Left(Right(olEntry.GetContact.CompanyName, 7), 6)
            If RCompanyName = CodeClient Then
            ActiveCell.Value = olEntry.GetContact.FullName
            ActiveCell.Offset(0, 1).Value = olEntry.GetContact.BusinessTelephoneNumber 'business phone number
            ActiveCell.Offset(0, 2).Value = olEntry.Address 'email address
            ActiveCell.Offset(0, 3).Value = olEntry.GetContact.CompanyName
            ActiveCell.Offset(0, 4).Value = olEntry.GetContact.BusinessAddress
            ActiveCell.Offset(1, 0).Select
            End If
        Next olEntry
    Next i

    Set olApp = Nothing
    Set olNS = Nothing
    Set olAL = Nothing
    Application.ScreenUpdating = True
    ActiveWorkbook.ActiveSheet.Range("K7").Select
End Sub

Answer 1

Try this.

Besides adding the If Nothing...'s, I tidied some of the other repetative code.

Option Explicit  'this line is recommended at the very top of every module.


'Function to import Outlook contacts according to their client code
Sub ExportOutlookAddressBook()
    Dim olApp As Outlook.Application, olNS As Outlook.Namespace, olAL As Outlook.AddressList
    Dim olEntry As Outlook.AddressEntry, CodeClient As String, RCompanyName As String, i As Long
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Application.ScreenUpdating = False
    Range("AA6:AF10").ClearContents

    For i = 1 To olNS.Accounts.Count
        Set olAL = olNS.AddressLists(i) 'Change name if different contacts list name
        Set olEntry = olAL.AddressEntries(1)
        CodeClient = ActiveWorkbook.ActiveSheet.Range("K6")
        ActiveWorkbook.ActiveSheet.Range("AA6").Select

        For Each olEntry In olAL.AddressEntries
            ' your looping code here
            RCompanyName = Left(Right(olEntry.GetContact.CompanyName, 7), 6)
            If RCompanyName = CodeClient Then
                With ActiveCell
                    .Value = olEntry.GetContact.FullName
                    .Offset(0, 1) = olEntry.GetContact.BusinessTelephoneNumber 'business phone number
                    .Offset(0, 2) = olEntry.Address 'email address
                    If Not olEntry.GetContact Is Nothing Then
                        If Not olEntry.GetContact.CompanyName Is Nothing Then
                            .Offset(0, 3) = olEntry.GetContact.CompanyName
                        End If
                        If Not olEntry.GetContact.BusinessAddress Is Nothing Then
                            .Offset(0, 4) = olEntry.GetContact.BusinessAddress
                        End If
                    End If
                    .Offset(1, 0).Select
                End With
            End If
        Next olEntry
    Next i

    Set olApp = Nothing
    Set olNS = Nothing
    Set olAL = Nothing
    Application.ScreenUpdating = True
    ActiveWorkbook.ActiveSheet.Range("K7").Select
End Sub