Excel VBAからActive Directoryにユーザー情報の問い合わせをかける

はじめに

わざわざVBAでやらなくてもPower QueryでAD相手にすれば良いじゃん。というのはその通りですが、ユーザー数が数万とかになってくるとPower Queryで処理するのもいちいち待たされてめんどくさいし、そうじゃなくても何らかの理由でマクロでやりたいというマイナー需要もあったりします。

とりあえず、できるようになったのは良いけど忘れそうなのでメモ

基本的にはActive DirectoryでいうところのsamAccountName(つまりWindowsログインID)でActive Directoryに問い合わせを掛け、登録されている必要情報を取得する。という流れです。

注意事項

ここで解説している内容を職場のActive Directoryサーバーに対して実践する場合は慎重に行ってください。
いきなり数千件のリクエストを叩きつけたりせず、十分にデバッグした上で様子を見ながらやること。

全社でログイン障害が発生したり、ネットワーク管理者に異常なアクセスとみなされて怒られたりしかねません。
このページの内容が間違っていて怒られたとかクビになったとかの場合でも、あたりまえですが責任はおえません

理屈抜きのサンプルコード

ごちゃごちゃ言わずにとりあえずコードを示します
だいたい使いそうな属性はこの例で取れるはず

※コピペしたままじゃ動かないかも

'ログイン中の所属ドメインを取得する
Function GetADDomain() As String
    Set objNetwork = CreateObject("WScript.Network")
    GetADDomain = objNetwork.UserDomain
End Function

'strAccountNameにログインIDをセットしてコールするとユーザー情報を取り出す
Function ViewUserInfo(strAccountName as String)
    Dim adoLDAPCon,adoLDAPRS,strLDAP,strDomainName

    strDomainName = GetADDomain()

    Set adoLDAPCon = CreateObject("ADODB.Connection")

    adoLDAPCon.Provider="ADsDSOObject"
    adoLDAPCon.Open "ADSI"
    strLDAP = "'LDAP://" & strDomainName & "'"
    
    'Active Directoryにクエリを投げる
    Set adoLDAPRS = adoLDAPCon.Execute("SELECT company,physicalDeliveryOfficeName,cn,sn,givenName,displayName,mail,telephoneNumber,title,description,departmentNumber from " & strLDAP & " WHERE objectClass = 'user'" & " And samAccountName = '" & strAccountName & "'")
    With adoLDAPRS
        if Not .EOF Then
            '備考
            debug.Print "Description=" & .Fields("description")
            
            '姓
            debug.Print "Description=" & .Fields("sn")
            
            '名
            debug.Print "Description=" & .Fields("givenName")
            
            '事業所
            debug.Print "Description=" & .Fields("physicalDeliveryOfficeName")

            'メールアドレス
            debug.Print "Description=" & .Fields("mail")

            '会社名
            debug.Print "Description=" & .Fields("company")

            '名(たぶん・・)
            debug.Print "Description=" & .Fields("cn")

            '表示名
            debug.Print "Description=" & .Fields("displayName")

            '部署コード
            debug.Print "Description=" & .Fields("departmentNumber")

            '役職
            debug.Print "Description=" & .Fields("title")

            '電話番号
            debug.Print "Description=" & .Fields("telephoneNumber")
        End If
    End With

    adoLDAPRS.Close
    Set adoLDAPRS = Nothing
    Set adoLDAPCon = Nothing
End Function

Nullが返ってきた場合の処理を入れてないのでTitle(役職)とかNullが返ってくる可能性のあるフィールドではIsNull使って引っ掛けてやるなどの手当は必要

他にもいろいろ取得できる。パスワード変更した日時とか、ロックアウト状態とか、最後のログイン時間とか。
ただし最後のログイン時間はドメインコントローラーが複数ある場合、そのユーザーが認証要求したドメインコントローラーにのみ記録されるとかで、必ずしも正しい最終ログイン時間が返ってくるとは限らない。

おまけ：パスワード変更期限を求める

変更期限を求める、とは書いたが、Active Directoryにはパスワード変更期限は保存されていない。されているのは最終パスワード変更日時のみ。

しかも、これがグレゴリオ暦でもなく、Posixタイムでもない謎の形式(NTタイムエポック)で記録されているので変換が甚だ面倒。
PowerShellとかだと一発変換コマンドがあるらしい。

いちおうルールは

• 100ナノ秒を1として
• 1601年1月1日 0:00を基準にしたときの
• 指定時刻までの累積カウント
  となっている。

基本的にGMTで記録されているのでJSTで欲しい場合はその考慮も必要。

変換するサンプルコードはこちら。
横着をしてGMTとJSTの差分を固定値(+540)で書いたが必要に応じて変更してください。

adoLDAPRS.Fields("pwdLastSet").Valueをそのままこの関数に渡してやればDate型に変換してくれるはず。

参考までにメモしておくと

• このオブジェクト(pwdLastSet)はlong型2つで構成されているのでまず合体させてから計算する。
• pwdLastSetが0の場合、本来は1601/1/1 0:00ということになるが、Excelが扱えるのは1899/12/31 0:00からなのでそれを設定している(セル上には1900/1/0 0:00と表示される)
• アカウント作成後一度もログインしてない状態だと何か変な値が格納されているかもしれない

変換したあとはそのドメインで設定されているパスワード有効期限(90日とか)を足してやれば求めることができる。

Function ConvertNTTE2Date(objPwdLastSet) As Date
    Dim lngHigh,lngLow
    Dim delta

    lngHigh = objPwdLastSet.HighPart
    lngLow = objPwdLastSet.LowPart

    If lngLow < 0 Then
        lngHigh = lngHigh + 1
    End If
    If lngLow = 0 And lngHigh = 0 Then
        ConvertNTTE2Date = #12/31/1899#
        Exit Function
    End If
    '上位Longをビットシフトして下位Longと合体
    delta = lngHigh * (2 ^ 32) + lngLow
    '全て分に直して計算。540はJSTへの換算
    delta = (delta / (60 * 10000000) + 540) / 1440
    ConvertNTTE2Date = delta + #1/1/1601#
End Function

参考URL