时间戳

首页 > 解决方案 > Excel VBA 代码在一台计算机之外工作 - 错误 91

excel - Excel VBA 代码在一台计算机之外工作 - 错误 91

问题描述

我有一个 Excel VBA 子程序，用于在 Outlook 中搜索联系人详细信息。

该函数可在许多计算机上运行，​​但该函数的主要用户除外，它会在该计算机上产生错误：

Error 91: Object variable or With block variable not set

有人能帮助我吗？

图像

'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

标签： excelvbaoutlook

解决方案

尝试这个。

除了添加If Nothing...'s，我还整理了一些其他重复的代码。

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

推荐阅读