エクセル(VBA)でWindowsのサインイン情報（パスワード）と照合可能か

■やりたいこと
エクセル(VBA)でパスワードの入力を要求して、それがWindowsのその人のサインイン時のパスワードと一致しているかどうかを判別したい


■詳細
添付画像をご覧ください。
ある共有ファイルがあり、そこにはユーザー名（AAA～DDD）が掲載されています。
そしてその隣にはその人たちの情報（○ or ×）が記載されいます。
この情報列の内容を編集できるのは、各ユーザーのみに制限をしたいのです。
そこで、各ユーザーのWindowsサインイン時のパスワードの入力を求められないかと思っています。

同環境のある別のシステムでは、サインインするときに、Windowsのサインイン情報と同じ情報が求められます。
サインインパスワードを変更したら、そのシステムにサインインする際は新しいパスワードの入力がもとめられます。
ということは、そのシステムはサインインパスワードを認識してるということになります。
なので、エクセルのこの状況でも同様の仕組みにできるのではないかと思いました。

別アプローチ（代替案）はいろいろ考えられるので、それは求めておらず、今回のアプローチ方法が技術的に可能かどうか、可能であれば具体的にどのような処理をすればよいかを知りたいです。
VBAは熟知しています。

もしかしたら、Windowsのサインイン情報がPC管理をしているサーバーに飛んで、別システムはそこを参照しているのかな？とも思っています。
そうなるとそのサーバーにアクセスは難しいので、同じアプローチは不可と思っています。


■動作環境
OS 名:Microsoft Windows 10 Pro
OS バージョン:10.0.16299 N/A ビルド 16299
OS 製造元:Microsoft Corporation
プロセッサ:Intel64 Family 6 Model 42 Stepping 7 GenuineIntel ~2400 Mhz
BIOS バージョン:TOSHIBA Version 2.20 , 2012/06/22
物理メモリの合計:3,988 MB
Excel バージョン:14.0.7192.5000(32ビット) Microsoft Office Standard 2010の一部


以上、心当たりあるかた、よろしくお願いいたします<(_ _)>

質問者からの補足コメント

• Active Directoryというのを初めて知りました。
  無知な分野ですので、見当違いのことを言ってる可能性がありますが、ご容赦ください。
  
  ご提示いただいたマクロを実行したところ、エラーなく実行されました。
  （Set objOpenDS = ..... apaswordの部分は「aPassword」に修正しました）
  
  しかし、パスワードはどれを使用しても、結果は「成功」となってしまいました。
  
  
  Debug.Print userAccountName, adName
  
  で値を確認すると、正しい値でした。
  正確には「adName」はlocal.....というもので、これが正しいかわかりませんが、ドメイン名と一致してるので正しいと予想しています。

    補足日時：2018/06/04 10:14

• 以下、2点不明点があります。
  
  ■不明点１
  On Error Resume Next以下、
  Set objOpenDS = objNS.openDSObject("LDAP://" & adName, userAccountName, aPassword, 1)
  で、「自分が所属する Active Directory ドメイン名」「アカウント名」「パスワード文字」の組み合わせが正しければ、エラーにならず、組合せが確認できなければ、エラーになると認識しています。
  
  今回aPasswordでどんな値でも結果は成功となりました。
  
  
  そこで、On Error Resume Nextを外してみたところ、
  
  
  実行時エラー '-2147023570 (8007052e)':
  
  オートメーション エラーです。
  ユーザー名またはパスワードが正しくありません。

    補足日時：2018/06/04 10:16

• というメッセージがでました。
  Err.Numberの数値を確認すると、メッセージ画面のとおり「-2147023570」でした。
  しかし、その後If Err.Number = 0 ThenではTrueを返しています。
  
  この理由は不明です。
  そこで、On Error Resume NextをOn Error GoTo Label_Err
  に変えてやると、この場合はエラーと認識して、Label_Err:に飛びました。
  
  
  ■不明点2
  上記対応時に判明したのですが、実はパスワードは正しいものでも、エラー（-2147023570）が発生していました。
  パスワードは確認しましたが、Windowsサインイン時のもので間違いありません。
  なぜエラーになるのか不明です。
  ちなみに、ドメイン名とユーザー名を取得してるのように、パスワードも取得できると思うのですが、どのように記述すればよいでしょうか。
  
  以上

    補足日時：2018/06/04 10:18

No.1 ベストアンサー 回答者： x-1919 回答日時： 2018/06/01 14:49

情報が足りずほとんど想像ですのでご容赦ください。

A) ユーザー アカウントの管理は Active Directory を使っている。
B) 現在ログオンしているユーザー アカウントは PC のローカルにあるアカウントではなく、AD のアカウントである。
C) 現在ログオンしているユーザー アカウントは、現在 PC を使用している個人のアカウントである。

以上より、アカウント名とパスワードの組み合わせの正当性評価は Active Directory のサーバーが行います。
評価してもらう処理は強い権限は必要ありません。 一般ユーザーの権限で大丈夫です。

評価に使う要素は 「自分が所属する Active Directory ドメイン名」「アカウント名」「パスワード文字」 の 3つで、ドメイン名とアカウント名は自動取得とし、パスワードだけを指定するようにしました。
ユーザー名をこちらから指定できないようにしたので簡易的ですが成りすましを防止したつもりです。

もっとも、質問者さんの環境を勝手に想像したものなので使い物にならない可能性もあります。

ユーザー確認が成功したら True、失敗したら False を返すようにしたので
If AuthenticateUser("パスワード文字") Then
　' 成功
Else
　' 失敗
End If
のように使います。

Function AuthenticateUser(aPassword As String) As Boolean
　' 戻り値
　Dim result As Boolean
　
　' ユーザーのアカウント名と所属ドメイン名を取得
　Dim objSysInfo As Object
　Dim objUser As Object
　Set objSysInfo = CreateObject("ADSystemInfo")
　Set objUser = GetObject("LDAP://" & objSysInfo.userName)
　
　Dim userAccountName As String
　Dim adName As String
　userAccountName = objUser.sAMAccountName
　adName = objSysInfo.DomainDnsName
　
　' 自動取得したユーザー情報と指定されたパスワードを使い、Active Directory のユーザー確認を行う
　On Error Resume Next
　Err.Clear
　
　Dim objLdap As Object
　Dim objOpenDS As Object
　Set objNS = GetObject("LDAP:")
　Set objOpenDS = objNS.openDSObject("LDAP://" & adName, userAccountName, apasword, 1)
　
　On Error GoTo 0
　
　If Err.Number = 0 Then
　　' 確認成功
　　result = True
　Else
　　' 確認できず
　　result = False
　End If
　
　AuthenticateUser = result
End Function

この回答へのお礼

ご回答ありがとうございます。
とても勉強になります。

文字制限があるため、補足にて検討内容を記載させていただきます。

お礼日時：2018/06/04 10:13