ActiveDirectoryのユーザー情報を取得するVBScript

ブログ

ADユーザー情報を取得するVBScript

興味のある方は少ないと思いますが、ActiveDirectoryからユーザー情報を取得するVBScriptを作成したので、備忘録として記事にしておきます。

Scriptを実行する事により、以下の情報を取得する事ができます。
取得後、EXCELシートに情報を格納します。

  1. ログオン名
  2. アカウント表示名
  3. アカウントの有効/無効状態
  4. アカウントのロック状態
  5. 最終ログオン日時
  6. 最終パスワード変更日時
  7. パスワード無期限かどうか
  8. アカウントの説明
  9. 所属グループ

以下がScriptの内容です。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   PG          :   ActiveDirectoryの調査
'   Author      :   2018/04/09 www.adlink-kk.ne.jp
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   定数(ActiveDirectory)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const ADS_SCOPE_SUBTREE                                 = 5
Const ADS_SCOPE_ONELEVEL                                = 1
Const ADS_UF_SCRIPT                                     = 1
Const ADS_UF_ACCOUNTDISABLE                             = 2
Const ADS_UF_HOMEDIR_REQUIRED                           = 8
Const ADS_UF_LOCKOUT                                    = 16
Const ADS_UF_PASSWD_NOTREQD                             = 32
Const ADS_UF_PASSWD_CANT_CHANGE                         = 64
Const ADS_UF_ENCRYPTED_TEXT_PASSWORD_ALLOWED            = 128
Const ADS_UF_TEMP_DUPLICATE_ACCOUNT                     = 256
Const ADS_UF_NORMAL_ACCOUNT                             = 512
Const ADS_UF_INTERDOMAIN_TRUST_ACCOUNT                  = 2048
Const ADS_UF_WORKSTATION_TRUST_ACCOUNT                  = 4096
Const ADS_UF_SERVER_TRUST_ACCOUNT                       = 8192
Const ADS_UF_DONT_EXPIRE_PASSWD                         = 65536
Const ADS_UF_MNS_LOGON_ACCOUNT                          = 131072
Const ADS_UF_SMARTCARD_REQUIRED                         = 262144
Const ADS_UF_TRUSTED_FOR_DELEGATION                     = 524288
Const ADS_UF_NOT_DELEGATED                              = 1048576
Const ADS_UF_USE_DES_KEY_ONLY                           = 2097152
Const ADS_UF_DONT_REQUIRE_PREAUTH                       = 4194304
Const ADS_UF_PASSWORD_EXPIRED                           = 8388608
Const ADS_UF_TRUSTED_TO_AUTHENTICATE_FOR_DELEGATION     = 16777216
Const E_ADS_PROPERTY_NOT_FOUND                          = &h8000500D
Const ONE_HUNDRED_NANOSECOND                            = 0.0000001
Const SECONDS_IN_DAY                                    = 86400
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   定数
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const i                                                 = 11
Const EXCEL_TEMLATE_FILE                                = "userInfo.xls"
Const EXCEL_DRIVER                                      = "Driver={Microsoft Excel Driver (*.xls)};DBQ=BookName;ReadOnly=False;"
Const ADS_PATH                                          = "LDAP://DC=example,DC=com"    '環境にあわせて変更
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   変数(ActiveDirectory)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private cnn                                             'ADODB.Connection（ActiveDirectory）
Private cmd                                             'ADODB.Command（ActiveDirectory）
Private rs                                              'ADODB.Recordset（ActiveDirectory）
Private con                                             'ADODB.Connection（ExcelBook）
Private maxPwdDays                                      'Password有効期限（PasswordPolisy）
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   変数(ユーザー情報)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private userInfo()  'ユーザー情報格納配列（○項目をExcelBookへ出力）
'userInfo(0)    :Adspath
'userInfo(1)    :アカウント名
'userInfo(2)    :アカウント表示名                   ○
'userInfo(3)    :ログオン名
'userInfo(4)    :ログオン名(Windows2000)             ○
'userInfo(5)    :アカウント有効/無効                 ○
'userInfo(6)    :アカウントロック                   ○
'userInfo(7)    :最終ログオン日時                   ○
'userInfo(8)    :最終パスワード変更日時                    ○
'userInfo(9)    :パスワード無期限                   ○
'userInfo(10)   :説明                         ○
'userInfo(11)   :所属グループ                     ○
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   処理
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Init()
Main()
Term()
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ActiveDirectoryに接続
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Init()
    On Error Resume Next
 
    Set cnn = CreateObject("ADODB.Connection")
    cnn.Provider = "ADsDSOObject"
    cnn.Open "Active Directory Provider"
 
    'PasswordPolisyからPassword有効期限を取得
    Set objDomain = GetObject("ADS_PATH")
    Set objMaxPwdAge = objDomain.Get("maxPwdAge")
    maxPwdNano = abs(objMaxPwdAge.HighPart * (2 ^ 32) + objMaxPwdAge.LowPart)
    maxPwdSecs = maxPwdNano * ONE_HUNDRED_NANOSECOND
    maxPwdDays = CInt(maxPwdSecs / SECONDS_IN_DAY)
 
    If Err Then
        Call Term()
        WScript.Echo "ActiveDirectoryに接続できませんでした！"
    End If
End Sub
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ユーザー情報を取得
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Main()
    On Error Resume Next
 
    'EXCELBOOKコピー＞接続
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set book = fso.GetFile(fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), EXCEL_TEMLATE_FILE))
    newbook = Replace(DateSerial(Year(Now),Month(Now),Day(Now)),"/","") & "_" & EXCEL_TEMLATE_FILE
    newbook = fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), newbook)
    book.Copy newbook
    Set book = Nothing
    Set fso = Nothing
    Set con = CreateObject("ADODB.Connection")
    con.Open Replace(EXCEL_DRIVER,"BookName",newbook)
     
    'ユーザー情報抽出
    Set cmd = CreateObject("ADODB.Command")
    Set cmd.ActiveConnection = cnn
    cmd.Properties("Page Size") = 1000
    cmd.Properties("Timeout") = 30
    cmd.Properties("Searchscope") = ADS_SCOPE_SUBTREE   '5階層迄検索
    cmd.Properties("Cache Results") = False
    cmd.CommandText = "SELECT AdsPath FROM '" & ADS_PATH & "' WHERE objectCategory='user'"
    Set rs = cmd.Execute
    rs.MoveFirst
    Do Until rs.EOF
        Redim userInfo(i)
        getUserInfo(GetObject(rs.Fields("AdsPath").Value))
        setExcelBook()
        rs.MoveNext
    Loop
    rs.Close
    cnn.Close
    con.Close
 
    If Err Then
        Call Term()
        WScript.Echo "ADスキーマ取得に失敗しました！"
    End If
End Sub
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ActiveDirectoryから切断
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Term()
    Set rs  = Nothing
    Set cmd = Nothing
    Set cnn = Nothing
    Set con = Nothing
    WScript.Quit
End Sub
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   ユーザー情報を配列に格納する
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub getUserInfo(ByRef objUser)
    On Error Resume Next
 
    userInfo(0) = objUser.AdsPath
    userInfo(1) = objUser.Name
    userInfo(2) = objUser.displayName
    userInfo(3) = objUser.userPrincipalName
    userInfo(4) = objUser.sAMAccountName
    If objUser.AccountDisabled = True Then
        userInfo(5) = "無効"
    Else
        userInfo(5) = "有効"
    End If
    If objUser.IsAccountLocked = True Then
        userInfo(6) = "ロック有"
    Else
        userInfo(6) = "ロック無"
    End If
    Set objLastLogon = objUser.Get("lastLogon")
    userInfo(7) = objLastLogon.HighPart * (2 ^ 32) + objLastLogon.LowPart
    userInfo(7) = userInfo(7) / (60 * 10000000)
    userInfo(7) = userInfo(7) / 1440
    userInfo(7) = userInfo(7) + #1/1/1601#
    userInfo(7) = userInfo(7) + #9:00:00 AM#
    On Error Resume Next
    userInfo(8) = objUser.passwordLastChanged
    If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
        userInfo(8) = "変更履歴なし"
        Err.Clear
    Else
        passday = DateDiff("d",userInfo(8),Now())   'パスワード変更後の経過日数
    End If
    On Error GoTo 0
    If Not objUser.userAccountControl AND ADS_UF_DONT_EXPIRE_PASSWD Then
        userInfo(9) = "期限あり"
    Else
        userInfo(9) = "期限なし"
    End If
    userInfo(10) = objUser.Description
    On Error Resume Next
    userInfo(11) = vbNullString
    If Not IsNull(objUser.GetEx("memberOf")) Then
        If Not Err Then
            For Each groupAdsPath in objUser.GetEx("memberOf")
                Set objGroup = GetObject("LDAP://" & groupAdsPath)
                If userInfo(11) <> vbnullstring Then
                    userInfo(11) = userInfo(11) & "・" & objGroup.CN
                Else
                    userInfo(11) = objGroup.CN
                End If
            Next
        End If
    End If
    Err.Clear
    On Error GoTo 0
 
    If Err Then
        Call Term()
        WScript.Echo "ユーザー情報取得に失敗しました！"
    Else
        WScript.Echo userInfo(4) & "　の情報を取得しました。"
    End If
End Sub
 
 
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   EXCELにユーザー情報を挿入する
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub setExcelBook()
    On Error Resume Next
 
    sql = vbNullString
    sql = sql & "INSERT INTO [userInfo$]("
    sql = sql & "ログオン名,"
    sql = sql & "アカウント表示名,"
    sql = sql & "アカウント有効・無効,"
    sql = sql & "アカウントロック,"
    sql = sql & "最終ログオン日時,"
    sql = sql & "最終パスワード変更日時,"
    sql = sql & "パスワード無期限,"
    sql = sql & "説明,"
    sql = sql & "所属グループ) "
    sql = sql & "VALUES('"
    sql = sql & userInfo(4) & "','"
    sql = sql & userInfo(2) & "','"
    sql = sql & userInfo(5) & "','"
    sql = sql & userInfo(6) & "','"
    sql = sql & userInfo(7) & "','"
    sql = sql & userInfo(8) & "','"
    sql = sql & userInfo(9) & "','"
    sql = sql & userInfo(10) & "','"
    sql = sql & userInfo(11) & "')"
    con.Execute sql
 
    If Err Then
        WScript.Echo userInfo(4) & "　のEXCEL出力に失敗しました！"
    End If
End Sub