web-dev-qa-db-ja.com

Excel（VBA）の値に基づいてOutlookアドレス帳からプルする方法

私は動作する次のコードを持っています（私はそれをフォーラムで見つけました）：

Public Sub GetUsers()
Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim myAddrList As AddressList
Dim myAddrEntries As addressEntry
Dim AliasName As String
Dim i As Integer, r As Integer
Dim EndRow As Integer, n As Integer
Dim myStr As String, c As Range
Dim myPhone As String
'Dim propertyAccessor As Outlook.propertyAccessor  'This only works with 2007 and may help you out

Set myolApp = CreateObject("Outlook.Application")
Set myNameSpace = myolApp.GetNamespace("MAPI")
Set myAddrList = myNameSpace.addressLists("Global Address List")

Dim FullName As String, LastName As String, FirstName As String
Dim StartRow As Integer

EndRow = Cells(Rows.Count, 3).End(xlUp).Row

StartRow = InputBox("At which row should this start?", "Start Row", 4)

For Each c In Range("A" & StartRow & ":A" & CStr(EndRow))
    AliasName = LCase(Trim(c))
    c = AliasName
    Set myAddrEntries = myAddrList.addressEntries(AliasName)

    FullName = myAddrEntries.Name
    FirstName = Trim(Mid(FullName, InStr(FullName, "(") + 1, _
                    InStrRev(FullName, " ") - InStr(FullName, "(")))
    LastName = Right(FullName, Len(FullName) - InStrRev(FullName, " "))
    LastName = Left(LastName, Len(LastName) - 1)

    c.Offset(0, 1) = FirstName
    c.Offset(0, 2) = LastName
    c.Offset(0, 3) = FirstName & " " & LastName
Next c
End Sub

単一の名前（名または姓）を指定すると、アドレス帳でその名前が検索され、見つかった人の姓名が返されます。

その人の企業IDを提供し、それを探してから他の情報（場所、電話番号など）を返したいのですが。

私はそれを行う方法を理解することはできません。まず第一に、ローカル変数でのみ宣言されていることがわかる限り、Outlookがエイリアスのみを検索することをどのように知っているのかわかりません。また、他の情報を引き出しようとすると、たとえば次のようになります。

HomeState = myAddrEntries.HomeState

エラーが発生します：オブジェクトはこのプロパティまたはメソッドをサポートしていません。そのプロパティが何と呼ばれるかわかりません-プロパティの名前を示すドキュメントをオンラインで見つけることができませんでした（MAPIドキュメントを検索した場合でも）。

だから、私の質問は-このコードを使用してIDで検索し、場所、番号などの他のプロパティを返すにはどうすればよいですか？また-そのプロセスを一般化するにはどうすればよいですか-これらのフィールド名の名前のリストはありますか？リストを生成する方法は？

ありがとう！

excelvbaoutlook
5
SimaPro

これがあなたを助けることができるかどうか見てみましょう。私はOutlookVBAの専門家ではありませんが、ほとんど同じであり、ドキュメントを見つけるだけです。

このページをブックマークして：

http://msdn.Microsoft.com/en-us/library/office/ff870566（v = office.14）.aspx

具体的には、AddressEntryオブジェクトのエントリを確認できます。

http://msdn.Microsoft.com/en-us/library/office/ff870588（v = office.14）.aspx

そしてそこから、利用可能なプロパティ/メソッドのリストを見ることができます。これで2番目の質問に答えられるはずですエラーが発生しました：オブジェクトはこのプロパティまたはメソッドをサポートしていません。そのプロパティが何と呼ばれるかわかりません。

HomestateはAddressEntryオブジェクトのプロパティではありません。

単一の名前（名または姓）を指定すると、アドレス帳でその名前が検索され、見つかった人の姓名が返されます。

これが100％信頼できると期待しないでください

私はこれを6つの名前でテストしましたが、そのうちの4つが正しかったです。 3つはまれな姓でした。 1つはフルネームで、驚くほど間違った結果を返しました。あなたのマイレージは異なる場合があります。

これは、大規模な組織では機能しません。アドレスリストが小さい場合は、単純な姓名の文字列に基づいて一意に解決するのは簡単です。しかしそうでなければ、これは信頼できません。

いくつか質問があります：

その人の企業IDを提供し、それを探してから他の情報（場所、電話番号など）を返したいのですが。

これは、Outlookがエイリアスからの電子メールアドレスを解決する方法ではないと思います。このようなクエリを実行するには、外部データベースを参照する必要があります。

ローカル変数でのみ宣言されていることがわかる限り、Outlookがエイリアスのみを検索することをどのように認識しているかはわかりません。

AliasNameは、サンプルコードではローカル変数でしたが、ユーザー入力（Excelスプレッドシートのセルなど）から値が割り当てられています。そのため、マクロはいくつかの値を読み取り、アドレス帳に対してそれらを解決しようとしています。

上で述べたように、これは単純な文字列が正しい個体に一意に解決される可能性と同じくらい良いです。

また、他の情報を引き出しようとすると、たとえば次のようになります。

HomeState = myAddrEntries.HomeState

エラーが発生します：オブジェクトはこのプロパティまたはメソッドをサポートしていません。そのプロパティが何と呼ばれるかわかりません-プロパティの名前を示すドキュメントをオンラインで見つけることができませんでした（MAPIドキュメントを検索した場合でも）。

より良い解決策はありますか？

はい。はい、できます。

オブジェクトモデルを掘り下げると、有望に見える2つの項目が見つかります。GetContactを返すContactItemメソッド（残念ながら、これは私たちが望むものではありません）とGetExchangeUserを返すExchangeUserです。あなたが探している情報の多くが含まれているので、これはあなたが望むものに最も近いと思います。

http://msdn.Microsoft.com/en-us/library/office/ff870767（v = office.14）.aspx

私はあなたのコードを次のように変更します：

Option Explicit

Public Sub GetUsers()

Dim myolApp As Outlook.Application
Dim myNameSpace As Namespace
Dim myAddrList As AddressList
Dim myAddrEntry As addressEntry   'I changed this variable to avoid ambiguity
Dim AliasName As String
Dim i As Integer, r As Integer
Dim c As Range
Dim EndRow As Integer, n As Integer
Dim exchUser As Outlook.ExchangeUser

Set myolApp = CreateObject("Outlook.Application")
Set myNameSpace = myolApp.GetNamespace("MAPI")
Set myAddrList = myNameSpace.addressLists("Global Address List")

Dim FullName As String, LastName As String, FirstName As String
Dim HomeState As String, PhoneNum As String
Dim StartRow As Integer

EndRow = Cells(Rows.Count, 3).End(xlUp).Row

StartRow = InputBox("At which row should this start?", "Start Row", 4)

For Each c In Range("A" & StartRow & ":A" & CStr(EndRow))
    AliasName = LCase(Trim(c))
    c = AliasName
    Set myAddrEntry = myAddrList.addressEntries(AliasName)
    Set exchUser = myAddrEntry.GetExchangeUser

    If Not exchUser Is Nothing Then
        FirstName = exchUser.FirstName
        LastName = exchUser.LastName
        HomeState = exchUser.StateOrProvince
        PhoneNum = exchUser.BusinessTelephoneNumber
        'etc...
    End If

Next c
End Sub
8
David Zemens

Microsoftのコードを取得し、それをExcelシートに適合させる方法は次のとおりです。

Sub DemoAE()

Dim colAL As Outlook.AddressLists
Dim oAL As Outlook.AddressList
Dim colAE As Outlook.AddressEntries
Dim oAE As Outlook.AddressEntry
Dim oExUser As Outlook.ExchangeUser
Dim ws As Worksheet
Dim r As range
Set ws = application.ActiveWorkbook.Worksheets("Users")
Set r = ws.range("A2")
Set colAL = Outlook.application.Session.AddressLists
TurnOff 'A function that turnsoff a bunch of memory hogging aspects of Excel when doing loops in sheets.

For Each oAL In colAL

'Address list is an Exchange Global Address List

If oAL.AddressListType = olExchangeGlobalAddressList Then
    Set colAE = oAL.AddressEntries
    For Each oAE In colAE
    If oAE.AddressEntryUserType = olExchangeUserAddressEntry Then
    Set oExUser = oAE.GetExchangeUser
        If oExUser.Alias <> "" And oExUser.PrimarySmtpAddress <> "" And oExUser.FirstName <> "" Then

            r = (oExUser.FirstName)
            r.Offset(0, 1) = (oExUser.LastName)
            r.Offset(0, 2) = (oExUser.Alias)
            r.Offset(0, 3) = (oExUser.PrimarySmtpAddress)
            If InStr(1, oExUser.Department, ",") <> 0 Then
                r.Offset(0, 4) = Left(oExUser.Department, InStr(1, oExUser.Department, ",") - 1)
            Else: r.Offset(0, 4) = oExUser.Department
            End If
        Set r = r.Offset(1, 0)
        End If
    End If
    Next

End If

Next
TurnOn 'A function that turns on a bunch of memory hogging aspects of Excel when not doing loops in sheets.

End Sub
0
JS20'07'11