Active DirectoryユーザのADSIを使ったセキュリティグループの取得方法

このQ&Aのポイント
  • Active Directoryに登録されているユーザからセキュリティグループ一覧を取得する方法を教えてください
  • 使用する環境はWindows2000+ACCESS2000VBAです。ADSIをつかって登録されているユーザからセキュリティグループを取得したいです
  • もしくは、ADOを使った別の方法でもセキュリティグループを取得できる方法があれば教えてください
回答を見る
  • ベストアンサー

Active DirectoryユーザのADSIを使ったセキュリティグループの取得

いつもお世話になります。 ADSIをつかってActive Directoryに登録されている1人のユーザから 登録されているセキュリティグループ一覧を取得する方法がわかる方 がおりましたらご教授頂きたく質問させて頂きました。 環境はWindows2000+ACCESS2000VBAです。 ちなみに何となくこんな感じというコードを書きます。 Dim objUser As IADsUser Set objUser = GetObject("'LDAP://' & 'CN='ユーザ名,' & 'CN=Users,' & 'DC=***,' & 'DC=co,' & 'DC=jp'") For Each ここがわかりません。 Next 別の方法でADOを使ったコードでも取得できそうですが、Where句のスキーマがわかりません。 下記のコードで登録ユーザのメールの一覧が取得できました。 Set Con = CreateObject("ADODB.Connection") Set Com = CreateObject("ADODB.Command") Con.Provider = "ADsDSOObject" Con.Open "Active Directory Provider" Set Com.ActiveConnection = Con Com.CommandText = "select name,mail from 'LDAP://DC=***, DC=co, DC=jp' WHERE " _ & "objectCategory='Person' " _ & "AND objectClass = 'user' " Set RS = Com.Execute While Not RS.EOF Debug.Print RS.Fields("Name") & " , " & RS.Fields("mail") RS.MoveNext Wend このSQLコマンドを select S_GROUP from *** where USER_ID に替えたいのです。 どちらかで結構なのでお願い致します。

  • sgh
  • お礼率100% (11/11)

質問者が選んだベストアンサー

  • ベストアンサー
noname#41381
noname#41381
回答No.1

とりあえず、始めのものだけですが... 所属するグループは"memberOf"というスキーマになりますが、 ユーザーのプライマリグループが参照しているのはPrimaryGroupID のグループ RID だけですのでこれでは取得できません。 詳細はこちらを参照してください。(サンプルもあります) http://support.microsoft.com/default.aspx?scid=kb;ja;JP321360

参考URL:
http://support.microsoft.com/default.aspx?scid=kb;ja;JP321360
sgh
質問者

お礼

ありがとうございました。 教えて頂いた参考URLで取得できました。 Dim oUsr As Object Dim oGrp As Object DomainName = "domain" UserLoginName = "administrator" Set oUsr = GetObject("WinNT://" & DomainName & "/" & UserLoginName & ",user") Set Grp = oUsr.Groups GrpID = oUsr.PrimaryGroupID GrpName = "" For Each Item In Grp NT4Name = Replace(Item.ADsPath, "WinNT://", "") tempArray = Split(NT4Name, "/") NT4Name = tempArray(1) Debug.Print NT4Name Next

関連するQ&A

  • 「Active Directoryプロパティがキャッシュに見つかりません」の回避

    VBAなのですがよろしくお願いします。 下記のようなActiveDirectoryにアクセスしてユーザーを検索しユーザーオブジェクトの”FullName”プロパティを表示させるスクリプトを実行させた時、FullNameプロパティが設定されているユーザーは問題なく表示されるのですが、Administratorなどのシステムに初めから登録されているユーザーの場合FullNameプロパティが登録されていないようで『Active Directoryプロパティがキャッシュに見つかりません』とエラーで止まってしまいます。 そこで、FullNameプロパティの有無を判別してif等で処理を分けたいのですが、プロパティの有無を確認する関数がわかりません。そういった関数はあるのでしょうか? 無い場合は何か他に回避策は考えられるでしょうか? ※administratorにFullNameプロパティを登録する等、ActiveDirectory側はあまりいじりたくありません。 --------- 検索するVBA ------------- Sub ADユーザー検索() Dim SearchStr SearchUser = "検索するユーザー" 'administratorだとエラーになる Const ADS_SCOPE_SUBTREE = 2 Dim objConnection Dim objCommand Dim objRecordSet Set objConnection = CreateObject("ADODB.Connection") Set objCommand = CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 1000 objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE objCommand.CommandText = _ "SELECT AdsPath FROM 'LDAP://dc=my,dc=domain' WHERE objectCategory='user' And (sAMAccountName='*" + SearchUser + "*' Or Name='*" + SearchUser + "*')" Set objRecordSet = objCommand.Execute Dim objUser If objRecordSet.EOF = False Then objRecordSet.MoveFirst Do Until objRecordSet.EOF Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value) Debug.Print objUser.FullName 'administratorだとここでエラーになる objRecordSet.MoveNext Loop End If End Sub ---------------------------- 長くなりましたがよろしくお願いします。

  • WMIを利用。

    はじめましてこんにちわ。 現在、WindowsのWSHのWMIを利用して、 パスワードが無期限ではないユーザーを無期限にしようと思っています。 以下、プログラムを利用して↑を実行しようと思っているのですが、 エラー:テーブルが存在しません。 と出てしまいます。どうすればよいでしょうか? 以下サンプルプログラムを見つけてVBSファイルにして実行しました。 [sample]パスワードが無期限じゃないユーザーを一括で無期限に szDomain = "dc=annou,dc=com" szOU = "OU=Students" Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 Set objConnection = CreateObject("ADODB.Connection") objConnection.Open "Provider=ADsDSOObject;" Set objCommand = CreateObject("ADODB.Command") objCommand.ActiveConnection = objConnection objCommand.Properties("Page Size") = 20000 objCommand.CommandText = _ "<LDAP://" & szOU & "," & szDomain & ">;" & _ "(&(objectCategory=person)(objectClass=user)" & _ "(!userAccountControl:1.2.840.113556.1.4.803:=65536));" & _ "userAccountControl,sAMAccountName,distinguishedName;" & _ "subtree" Set objRecordSet = objCommand.Execute Do Until objRecordset.EOF szDN = objRecordset.Fields("distinguishedName") intUAC = objRecordset.Fields("userAccountControl") Set objUser = GetObject("LDAP://" & szDN ) objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD objUser.SetInfo WScript.Echo szDN objRecordset.MoveNext Loop objConnection.Close Set objCommand = Nothing

  • 2次元のdictionary

    こんにちは。 recordsetの結果をDictionaryにいれたいと思っています。 環境はWindows Vista、vbScriptで書いています。 set dc = createobject("scripting.dictionary") Set rs = Server.CreateObject("ADODB.Recordset") rs.open (sql文), con  for i = 0 to rs.recordcount -1 for j = 0 to rs.fields.count - 1 dc.add rs.fields(j).name, rs.fields(j).value next next ちょっとイメージっぽく書きましたが(このままではエラーでます)、要は複数のフィールドを持つ複数のレコードを入れられないかということです。 色々調べたりしてみたのですがわかりません。 できないのかな?と思いました。 もしできるなら書き方をご教授頂けたらと思います。 よろしくお願いします。

  • wshでcsvファイルのソートを行いたい

    wshのプログラムで困っているため教えてください。 wshでcsv(カンマ区切り)のファイルのソートを行い、Escel形式で保存するプログラムを書いています。 調べてみたところ、wshではソート関数がないようで、 adodbのsort関数を使用して対処しようとしていますが、どうもうまくいきません。 (※adodbの必要はないのですが、ExcelVBAのsortのコードを書こうとするとエラーになってしまったので、adodbにしています。) <仕様> csvファイルのソートのキーになるのは、「判定区分」の値で昇順に行いたいです。 csvファイルの一行目は、カラム名としてソート対象にはなりません。 読み込んだcsvファイルをexcel形式に保存したいです。 ■csvファイルの形式は、以下のような形です。 性別,年代,判定区分,生年月日,日付 女性,10,0,2010/01/10,2013/7/7 23:57 男性,50,2,2000/03/30,2013/7/7 13:7 女性,10,0,1990/01/20,2013/7/7 15:22 女性,20,1,2001/12/10,2013/7/7 8:10 *----------------------------------- <ソース> Set con = CreateObject("ADODB.Connection") With con .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Path & ";" _ & "Extended Properties='text;HDR=Yes;FMT=Delimited'" .Open End With Set rec = CreateObject("ADODB.Recordset") rec.Open "select * from " & csvfile & " order by 判定区分", con *----------------------------------- うまくいかないため ↓でも書いています。 *----------------------------------- Const adDate = 7 Const adVarChar = 200 Dim ans Set objADO = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") Set re = CreateObject("VBScript.RegExp") rs.Fields.Append "性別", adVarChar, 255 rs.Fields.Append "年代", adVarChar, 255 rs.Fields.Append "判定区分", adVarChar, 255 rs.Fields.Append "生年月日", adDate rs.Fields.Append "日付", adDate rs.Open ans = "" rs.Sort ="判定区分 ASC" rs.MoveFirst Do While Not rs.EOF ans = ans & rs.Fields(0).Value & vbCrLf rs.MoveNext Loop MsgBox ans エラーになってしまいます。 ソート処理だけですでににっちもさっちもいかないため、教えていただきたいです。 どうぞ宜しくお願いいたします。

  • WMIを利用。Part2

    はじめましてこんにちわ。 現在、WindowsのWSHのWMIを利用して、 パスワードが無期限ではないユーザーを無期限にしようと思っています。 ソースコードをさがしたり、こちらの質問箱に質問したところ、 どうも ・ソースコードが正しく走るのは確認が取れている。 ・こちら側の環境で走らない。(ActiveDirectoryなどほか) ・逆にスタンドアロンの環境でもいいので走らないか。 ということです。 どうぞご回答よろしくお願いします。 ソースは以下です。 Option Explicit Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 Dim WshShell Dim strEnvDnsDomain, arrItem, baseDN, i Dim szDomain, szOU, szDN, intUAC, objUser Dim objConnection, objCommand, objRecordSet Dim strCommandText szOU = "OU=Students" Set WshShell = CreateObject("WScript.Shell") strEnvDnsDomain = WshShell.ExpandEnvironmentStrings("%USERDNSDOMAIN%") If Left(strEnvDnsDomain, 1) = "%" Then WScript.Echo "操作しているPCはActive Directoryドメインに参加していないようです。" & vbNewLine & "終了します。" WScript.Quit End If arrItem = Split(strEnvDnsDomain, ".") baseDN = "" For i = 0 to UBound(arrItem) If i = 0 Then baseDN = "DC=" & arrItem(i) Else baseDN = baseDN & ",DC=" & arrItem(i) End If Next szDomain = baseDN Set objConnection = CreateObject("ADODB.Connection") Set objCommand = CreateObject("ADODB.Command") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" objCommand.ActiveConnection = objConnection strCommandText = "<LDAP://" & szOU & "," & szDomain & ">;" & _ "(&(objectCategory=person)(objectClass=user)" & _ "(!userAccountControl:1.2.840.113556.1.4.803:=65536));" & _ "userAccountControl,sAMAccountName,distinguishedName;" & _ "subtree" objCommand.CommandText = strCommandText Set objRecordSet = objCommand.Execute Do Until objRecordset.EOF szDN = objRecordset.Fields("distinguishedName") intUAC = objRecordset.Fields("userAccountControl") Set objUser = GetObject("LDAP://" & szDN ) objUser.Put "userAccountControl", intUAC XOR ADS_UF_DONT_EXPIRE_PASSWD objUser.SetInfo WScript.Echo szDN objRecordset.MoveNext Loop objConnection.Close Set objCommand = Nothing WScript.Echo "END"

  • ADOでテーブルのフィールド「A」の「0000」の数を数えたい。

    エクセルVBAからアクセスへ Set con = New ADOdb.Connection con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ACCESSファイル名 Set Rs = New ADOdb.Recordset Rs.Open テーブル名, con, adOpenKeyset, adLockOptimistic Debug.Print Rs.RecordCount Set Rs = Nothing Set con = Nothing とエクセルVBAにコードを記述していますが思いどおりにいきません。 Debug.Print Rs.RecordCount しかわからなく これだとレコードの数しか数えられませんでした。 テーブルのフィールド「A」には「0000」が複数あります。 これを数えるにはどうすればいいのでしょうか? もっといいやり方があれば教えてくださいませ。 よろしくお願いします。

  • ADOによるCSVファイルからのデータ取得

    EXCELVBAを用いて、ADODB.CONNECTIONによりデータを取得しようと思い、ネットで調べた プログラムを使ってみたのですが、途中のレコードまでしか取得できませんでした。 ちなみに、データを取得しようと思っているもとのCSVファイルのサイズは10GB超、レコード数は 800万行程度あります。 これが、数十MB程度のファイルだと問題なかったのですが、レコード数などに制限はあるのでしょうか。 ご教示いただけますと幸いです。 用いたマクロの構文は以下のとおりです。 Dim con As New ADODB.Connection Dim connectionString As String Dim csvFilePath As String Dim rs As ADODB.Recordset Dim colNo As Long Dim fileNumber As Long Dim Buffer As String 'CSVファイルが置かれているフォルダ csvFilePath = E:\ connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=" & csvFilePath & ";" _ & "Extended Properties=""Text;HDR=NO;FMT=Delimited""" 'コネクションオープン con.Open connectionString 'ここでSQL文によりレコードを取得します。 Set rs = con.Execute("SELECT COUNT(*) FROM XXX.CSV") fileNumber = FreeFile Open OutputFolder & Application.PathSeparator & OutputFile For Output As #fileNumber Buffer = "" ’ヘッダーの出力 For colNo = 0 To rs.Fields.Count - 1 If Buffer <> "" Then Buffer = Buffer & "," End If Buffer = Buffer & rs.Fields(colNo).Name Next Print #fileNumber, Buffer ’データの出力 Do While rs.EOF = False Buffer = "" For colNo = 0 To rs.Fields.Count - 1 If Buffer <> "" Then Buffer = Buffer & "," End If Buffer = Buffer & rs.Fields(colNo).Value Next Print #fileNumber, Buffer '次のレコード rs.MoveNext Loop Close #fileNumber 'クローズ con.Close Set rs = Nothing Set con = Nothing End Sub

  • ExcelにADのセキュリティグループのメンバーを表示させる

    Visual Basicが全くわかっていないので、どなたか教えてください。 前任者が、OutlookのセキュリティグループのメンバーをExcelに表示させるVBSを残していきました。 とても便利に使っていましたが、ADのセキュリティグループに1500以上のユーザーが登録されているのに、 どういうわけか1500件までしか表示されません。どうやったらセキュリティグループのメンバー全員を吐き出すことができるんでしょうか? Dim objGroup, objExcel, iRow, strUser Set objGroup = GetObject("LDAP://cn=[セキュリティグループ名],ou=Distribution Groups,ou=XXXXX,dc=[domain]…") Set objExcel = CreateObject("Excel.Application") With objExcel .SheetsInNewWorkbook = 1 .Workbooks.Add .Visible = True .Worksheets.Item(1).Name = mid(objGroup.Name, instr(1,objGroup.Name,"=") + 1 ) 'set Worksheet name to that of the DL irow=1 For Each strUser in objGroup.Member Set objUser = GetObject("LDAP://" & strUser) .Cells(iRow,1) = objUser.CN irow=irow + 1 Next .Cells(iRow,1) = "Total users: " & irow - 1 .Columns(1).entirecolumn.autofit End With Set objExcel = Nothing Set objGroup = Nothing よろしくお願いいたします。

  • ASPでExcelのセルに罫線、色付け

    WebサーバーにExcelがセットアップされてないので、 Set rs=Server.CreateObject("ADODB.Recordset") を使用し、Excelオブジェクトを作成後、 接続文字列、SQLを渡して、レコードセットを開きました。 strSQL = "select * from DATA_RANGE" Rs.Open strSQL, Con, 0 '0=adOpenForwardOnly 以下のようにして、Excelに値をセットすることはできたのですが、 rs.Fields(0).Value = "AAA" 罫線や、色をつける方法がわかりません。 どうかご教授ください。

  • ExcelからAccessのテーブルの値の取得ができない

    Excel2003からAccess2003のDBの値を取得するVBAを作成中なのですが、 ExcelのフォームにてTextBox1に入力した社員番号からネットワーク接続されたサーバーにあるmdbファイルから値を取得する内容で 以下のエラーが表示されます。  「実行時エラー '-2147217904 (80040e10)':   1つ以上の必要なパラメータの値が設定されていません。」 デバッグをすると、「rs1.Open sql1, con」の箇所と指摘されます。 以下にコードを貼り付けますので、間違っている点のご指摘をお願いいたします。 Private Sub CommandButton2_click() Dim shainID As Long Dim constr As String '接続文字列の定義 Dim con As ADODB.Connection Dim rs1 As ADODB.Recordset If TextBox1.Value = "" Then MsgBox "社員番号を入力してください", vbOKOnly + vbCritical, "社員番号入力エラー" TextBox1.SetFocus Else shainID = TextBox1.Value Range("B13").Value = shainID 'Connectionの設定 Set con = CreateObject("ADODB.Connection") constr = "provider = Microsoft.Jet.OLEDB.4.0;Data Source = \\192.168.1.100\ShainDB\shaindb.mdb" 'DB接続 con.Open constr 'RecordSetの作成 Set rs1 = CreateObject("ADODB.Recordset") 'SQL sql1 = "select 社員漢字氏名,性別,生年月日,電話番号,住所 from 社員テーブル where 社員番号 = shainID" If sql1 = "" Then MsgBox "入力した社員番号の社員はいません。", vbOKOnly + vbCritical, "社員番号入力エラー" TextBox1.SetFocus Else 'SQLを実行して対象をRecordSetに入れる rs1.Open sql1, con Set rs1 = con.sql1 Range("B14").Value = 社員漢字氏名 Range("B15").Value = 性別 Range("B16").Value = 生年月日 Range("B17").Value = 電話番号 Range("B18").Value = 住所 Unload Me 'フォームを閉じる End If End If End Sub