社員IDから社員情報を解決する際に、AD(ActiveDirectory)から取ってくれば楽じゃんとおもいました。CUIなら簡単に作れるが、GUIで作るとなると結構厄介だ。しかしHTAという強い味方がWindowsにはいるのだ。
HTAはテキストベースなので、コンパイラがいらない。カスタマイズもテキストエディタさえあれば可能だ。
以下のコードのうち、「LDAPName」さえ変更すればそこそこ動くんじゃないだろうか。
<!---------------------------------------------------------------------------------->
<!--date new/upd/del author comments -->
<!--2015/02/27 新規作成 marujx -->
<!--20XX/XX/XX -->
<!---------------------------------------------------------------------------------->
<html><head>
<title>AD問い合わせツール</title></head>
<body>
<form name="formMain">
ADへの社員問い合わせを行います。<BR>
組み合わせ検索は行えません。複数条件を指定した場合、上の条件で検索されます。
<p>
<input type="button" value="問い合わせ実行" onClick="ADQuery()" />
</p>
社員ID<input type="text" name="ID" cols="16" value="" /><BR>
備考<input type="text" name="Code" rows="25" value="" /><BR>
社員名<input type="text" name="Name" rows="25" value="" /><BR><BR>
社員名 社員ID 備考 部署
<textarea name="Result" cols="80" rows="15">
</textarea>
</form>
<script language="VBScript">
Option Explicit
Sub Window_onLoad
window.resizeTo 640,480
End Sub
sub ADQuery()
Dim LDAPName
Dim baseDN, objRootDSE
Dim objConnection, objCommand, strCommandText
Dim objRecordSet, strUserDN
baseDN = ""
'LDAPサーバ名を記載
LDAPName = "LDAP://hoge.co.jp"
' ベースDNの取得
On Error Resume Next
Set objRootDSE = GetObject("LDAP://rootDSE")
If Err.Number <> 0 Then
WScript.Echo "ドメイン接続に失敗しました。終了します。"
WScript.Quit
Else
baseDN = objRootDSE.Get("defaultNamingContext")
End If
msgbox baseDN
On Error Goto 0
' DCに接続して検索
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
Dim objADSystemInfo
Dim objUser
Dim Result
Dim Code
Dim id
Dim Name
If document.formMain.code.value<>"" then
Code = document.formMain.code.value
objCommand.CommandText = _
"SELECT description,DisplayName,cn,Department FROM '" & LDAPName & "' WHERE Description='" & code & "'"
ElseIF document.formMain.ID.value<>"" then
id = document.formMain.ID.value
objCommand.CommandText = _
"SELECT description,DisplayName,cn,Department FROM '" & LDAPName & "' WHERE cn='" & id & "'"
ElseIF document.formMain.Name.value<>"" then
Name = document.formMain.Name.value
objCommand.CommandText = _
"SELECT description,DisplayName,cn,Department FROM '" & LDAPName & "' WHERE DisplayName='*" & Name & "*'"
Else
Exit sub
End If
Set objRecordSet = objCommand.Execute
Do
If (objRecordSet.EOF) Then
Exit Do
End If
Dim vDescVal
Dim vDescVals
Result = Result & objRecordSet.Fields("DisplayName")
Result = Result & " " & objRecordSet.Fields("cn")
Result = Result & " "
If Not IsNull(objRecordSet.Fields("description")) Then
vDescVals = objRecordSet.Fields("description")
For Each vDescVal In vDescVals
Result=Result & vDescVal
Next
End If
Result = Result & " " & objRecordSet.Fields("Department") & vbcrlf
objRecordSet.MoveNext
Loop
document.formMain.Result.value=Result
Set objRecordSet = Nothing
Set objADSystemInfo = Nothing
End sub
</script>
</body></html>
