csvdeでエクスポートしたデータの必要項目をVBScriptで取り出す

csvdeでエクスポートしたActiveDirectoryのユーザーデータをVBScriptで読み込み、必要項目を配列に格納する際のメモです。

・csvdeでエクスポートしたUNICODEのCSVを読み込む
・ヘッダーを読み込み必要な項目のINDEX番号を取得
・データ部分を配列に入れる（レコードの除外あり）

あとは、INDEX番号を指定して意図した列順にして、Shift_JISにして書き出したり（エクセルで開いたときにちゃんとカンマ区切りで列が分かれます）、判定に使ったり、メール飛ばしたりして使えます。

最初から項目を指定してエクスポート指定もできますが、Dnの項目は残ってしまうのと、1日1回エクスポートしたADのデータを複数の用途で使用するときに、この方が汎用的だと思って作りました。

バージョンアップで項目が増えても、元々の項目名が変わらなければ使えますしね。

ただ、SQL分かるよって人は「ADOを使ってCSVファイルのデータを取得する方法」を調べてそちらを使うことを強く推奨します、あくまでもこんな方法もあるよってことで・・・
(ロクに調べもせずにとりあえず作成したなんてとても言えない(^_^;))

'*****************************************
'メイン処理
'*****************************************

 '必要オブジェクト
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set objWShell = CreateObject("WScript.Shell")

 'ADデータをエクスポート
  objWShell.Run "cmd /c csvde -u -f ExportAD.csv -r objectCategory=user",1,True

  'ヘッダーを配列に格納
  Set oFile1 = FSO.OpenTextFile(InputFile, 1, , -1)
  Line1 = oFile1.ReadLine
  CountArr = ArrCount(Line1,",")
  ArrInput Line1 , ArrHead1 , CountArr , ","

 '一致する名前のINDEX取得
  memberOfNum = ArrSearch("memberOf",ArrHead1)
  sAMAccountNameNum = ArrSearch("sAMAccountName",ArrHead1)
  departmentNum = ArrSearch("department",ArrHead1)
  displayNameNum = ArrSearch("displayName",ArrHead1)
  pwdLastSetNum = ArrSearch("pwdLastSet",ArrHead1)
  lastLogonTimestampNum = ArrSearch("lastLogonTimestamp",ArrHead1)
  mailNum = ArrSearch("mail",ArrHead1)

'  ADデータを配列に格納
  Do      
    LoopSW1 = 1
    Do Until oFile1.AtEndOfLine = True
      Line1 = oFile1.ReadLine
      ArrInput Line1 , ArrData1 , ArrCount(Line1,",") , ","
      'TESTユーザーは除外
      If InStr(ArrData1(memberOfNum),"test_users") = 0 and Then
        LoopSW1 = 0
        Exit Do
      End if
    Loop
  Loop


'*****************************************
'特定の値が入った配列のINDEXを返す
'*****************************************
Function ArrSearch(SearchStr,ArrData)
  Dim MaxArr
  Dim X
  ErrProcedure= "ArrSearch"
  MaxArr = UBound(ArrData)
  For X = 0 To MaxArr
    if SearchStr = ArrData(X) Then
      ArrSearch = X
      Exit For
    End if
  Next
End Function


'*****************************************
'１行の配列格納に必要な最大Index値を返す
'*****************************************
Function ArrCount(StrLine,CutStr)
  Dim X
  Dim MaxStr
  Dim PSW
  ErrProcedure= "ArrCount"
  ArrCount = 0
  if CutStr = "" then CutStr=","
  MaxStr = Len(StrLine)
  if MaxStr <= 0 then Exit Function
  For X = 1 To MaxStr
    if Mid(StrLine,X,1) = """" then
      if PSW = 0 then
        PSW = 1
      Else
        PSW = 0
      End if
    End if
    if Mid(StrLine,X,1) = CutStr and PSW = 0 then ArrCount = ArrCount + 1 
  Next
End Function


'*****************************************
'１行を配列に格納する
'*****************************************
Sub  ArrInput (ByVal StrLine,ByRef ArrData,ByVal ArrCount,ByVal CutStr)
  Dim X1
  Dim X2
  Dim StrText
  Dim MaxStr
  Dim PSW
  PSW = 0
  ReDim ArrData(ArrCount)
  MaxStr = Len(StrLine)
  if MaxStr <= 0 then Exit Sub
  For X1 = 1 To MaxStr
    if Mid(StrLine,X1,1) = """" then
      if PSW = 0 then
        PSW = 1
      Else
        PSW = 0
      End if
    End if
    if Mid(StrLine,X1,1) = CutStr and PSW = 0 then 
      ArrData(X2) = StrText
      X2 = X2 + 1
      StrText = ""
      if X2 > ArrCount Then Exit For
    End if
    if  Mid(StrLine,X1,1) <> """" and Mid(StrLine,X1,1) <> CutStr or Mid(StrLine,X1,1) = CutStr and PSW = 1 then
        StrText = StrText & Mid(StrLine,X1,1)
    End if   
  Next
End Sub