<% ' %> <% main() Sub main() If Not(SessionCheck()) Then Exit Sub End If Dim Sheet Sheet = Request("Sheet") Dim ExcelDir ExcelDir = Request("ExcelDir") Dim FileName FileName = Request("FileName") Dim Header Header = Request("Header") Dim GroupCD GroupCD = Request("GroupCD") Dim RouteType RouteType = Request("RouteType") Dim Url Url = Request.ServerVariables("URL") Dim db Set db = InitQuery() Dim ExcelConnection Dim Query Dim Content Dim Content2 Dim rs ExcelConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(ExcelDir) & "\" & FileName & ";Extended Properties=" If Header = "ON" Then ExcelConnection = ExcelConnection & "Excel 8.0;" Else ExcelConnection = ExcelConnection & "'Excel 8.0;HDR=NO'" End If ' ExcelConnection = "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & Server.MapPath(ExcelDir) & "\" & FileName & ";" Query = "select * from [" & Sheet & "]" Set rs = Server.CreateObject("ADODB.Connection") rs.ConnectionTimeout = 60 rs.CommandTimeout = 60 rs.Open ExcelConnection Set Content = rs.Execute(Query) 'クエリ結果待機処理(Contentに結果が返っていないか、もしくはNothing以外の結果が返っている間ループさせる) ' Nothingであれば正しく「フィールド無し」の結果が返っているのでループ内処理を行わなず次へ。 ' Nothingでない場合は (1)正しくフィールド結果が返っている (2)まだ結果が返っていない の2パターンがあり得るので ' (1)であればその時点でループを抜け、(2)の場合は念のためNextRecordSet()を発行してからループ先頭に戻る。 Do While Not Content Is Nothing If Content.Fields.Count > 0 Then Exit Do End If Set Content = Content.NextRecordSet() Loop Dim TmpRow ReDim TmpRow(0) '(0)は予備配列として実際の処理では捨てる TmpRow(UBound(TmpRow)) = "" Dim ii Dim jj Dim bCheck bCheck = 3 Dim TmpValue Dim TmpValue2 Dim TmpContent(5) '要素を配列に変換 Do While Not(Content.EOF Or Content.BOF) TmpContent(0) = ConvProhiStr("" & Content(0)) TmpContent(1) = ConvProhiStr("" & Content(1)) If Content.Fields.Count > 2 Then TmpContent(2) = ConvProhiStr("" & Content(2)) End If If Content.Fields.Count > 3 Then TmpContent(3) = ConvProhiStr("" & Content(3)) End If ' TmpContent(4) = ConvProhiStr("" & Content(4)) bCheck = "true" For ii = 0 to 3 If ii <> 2 And ii <> 3 And ("" & TmpContent(ii) = "" Or "" & TmpContent(ii) = " " Or "" & TmpContent(ii) = " ") Then 'バッドエントリ bCheck = 0 Exit For End If If ii = 0 Then TmpValue2 = "" & TmpContent(ii) TmpValue2 = Replace(TmpValue2, "a","") 'ユーザーID不正文字 TmpValue2 = Replace(TmpValue2, "b","") TmpValue2 = Replace(TmpValue2, "c","") TmpValue2 = Replace(TmpValue2, "d","") TmpValue2 = Replace(TmpValue2, "e","") TmpValue2 = Replace(TmpValue2, "f","") TmpValue2 = Replace(TmpValue2, "g","") TmpValue2 = Replace(TmpValue2, "h","") TmpValue2 = Replace(TmpValue2, "i","") TmpValue2 = Replace(TmpValue2, "j","") TmpValue2 = Replace(TmpValue2, "k","") TmpValue2 = Replace(TmpValue2, "l","") TmpValue2 = Replace(TmpValue2, "m","") TmpValue2 = Replace(TmpValue2, "n","") TmpValue2 = Replace(TmpValue2, "o","") TmpValue2 = Replace(TmpValue2, "p","") TmpValue2 = Replace(TmpValue2, "q","") TmpValue2 = Replace(TmpValue2, "r","") TmpValue2 = Replace(TmpValue2, "s","") TmpValue2 = Replace(TmpValue2, "t","") TmpValue2 = Replace(TmpValue2, "u","") TmpValue2 = Replace(TmpValue2, "v","") TmpValue2 = Replace(TmpValue2, "w","") TmpValue2 = Replace(TmpValue2, "x","") TmpValue2 = Replace(TmpValue2, "y","") TmpValue2 = Replace(TmpValue2, "z","") TmpValue2 = Replace(TmpValue2, "A","") TmpValue2 = Replace(TmpValue2, "B","") TmpValue2 = Replace(TmpValue2, "C","") TmpValue2 = Replace(TmpValue2, "D","") TmpValue2 = Replace(TmpValue2, "E","") TmpValue2 = Replace(TmpValue2, "F","") TmpValue2 = Replace(TmpValue2, "G","") TmpValue2 = Replace(TmpValue2, "H","") TmpValue2 = Replace(TmpValue2, "I","") TmpValue2 = Replace(TmpValue2, "J","") TmpValue2 = Replace(TmpValue2, "K","") TmpValue2 = Replace(TmpValue2, "L","") TmpValue2 = Replace(TmpValue2, "M","") TmpValue2 = Replace(TmpValue2, "N","") TmpValue2 = Replace(TmpValue2, "O","") TmpValue2 = Replace(TmpValue2, "P","") TmpValue2 = Replace(TmpValue2, "Q","") TmpValue2 = Replace(TmpValue2, "R","") TmpValue2 = Replace(TmpValue2, "S","") TmpValue2 = Replace(TmpValue2, "T","") TmpValue2 = Replace(TmpValue2, "U","") TmpValue2 = Replace(TmpValue2, "V","") TmpValue2 = Replace(TmpValue2, "W","") TmpValue2 = Replace(TmpValue2, "X","") TmpValue2 = Replace(TmpValue2, "Y","") TmpValue2 = Replace(TmpValue2, "Z","") TmpValue2 = Replace(TmpValue2, "0","") TmpValue2 = Replace(TmpValue2, "1","") TmpValue2 = Replace(TmpValue2, "2","") TmpValue2 = Replace(TmpValue2, "3","") TmpValue2 = Replace(TmpValue2, "4","") TmpValue2 = Replace(TmpValue2, "5","") TmpValue2 = Replace(TmpValue2, "6","") TmpValue2 = Replace(TmpValue2, "7","") TmpValue2 = Replace(TmpValue2, "8","") TmpValue2 = Replace(TmpValue2, "9","") TmpValue2 = Replace(TmpValue2, "-","") TmpValue2 = Replace(TmpValue2, "_","") If TmpValue2 <> "" Then bCheck = 3 Exit For End If If Len("" & TmpContent(ii)) > 12 Then 'ユーザーID文字数オーバー bCheck = 4 Exit For End If For jj = 1 To UBound(TmpRow) If UCase("" & TmpContent(ii)) = UCase(Left(TmpRow(jj), InStr(TmpRow(jj), ",") - 1)) Then 'リスト内ユーザーID重複 bCheck = 2 Exit For End If Next Query = "exec SPMユーザー取得 '" & GB_SystemCD & "', '" & TmpContent(ii) & "'" Set Content2 = OpenQuery(Query) If Not(Content2.BOF Or Content2.EOF) Then 'ユーザーID重複 bCheck = 1 Exit For End If End If If ii = 1 Then If Len("" & TmpContent(ii)) > 9 Then '氏名文字数オーバー bCheck = 5 Exit For End If End If If ii = 2 Then If AscLen("" & TmpContent(ii)) > 8 Then '略氏名文字数オーバー bCheck = 6 Exit For End If End If If ii = 3 Then TmpValue2 = "" & TmpContent(ii) TmpValue2 = Replace(TmpValue2, "a","") 'パスワード不正文字 TmpValue2 = Replace(TmpValue2, "b","") TmpValue2 = Replace(TmpValue2, "c","") TmpValue2 = Replace(TmpValue2, "d","") TmpValue2 = Replace(TmpValue2, "e","") TmpValue2 = Replace(TmpValue2, "f","") TmpValue2 = Replace(TmpValue2, "g","") TmpValue2 = Replace(TmpValue2, "h","") TmpValue2 = Replace(TmpValue2, "i","") TmpValue2 = Replace(TmpValue2, "j","") TmpValue2 = Replace(TmpValue2, "k","") TmpValue2 = Replace(TmpValue2, "l","") TmpValue2 = Replace(TmpValue2, "m","") TmpValue2 = Replace(TmpValue2, "n","") TmpValue2 = Replace(TmpValue2, "o","") TmpValue2 = Replace(TmpValue2, "p","") TmpValue2 = Replace(TmpValue2, "q","") TmpValue2 = Replace(TmpValue2, "r","") TmpValue2 = Replace(TmpValue2, "s","") TmpValue2 = Replace(TmpValue2, "t","") TmpValue2 = Replace(TmpValue2, "u","") TmpValue2 = Replace(TmpValue2, "v","") TmpValue2 = Replace(TmpValue2, "w","") TmpValue2 = Replace(TmpValue2, "x","") TmpValue2 = Replace(TmpValue2, "y","") TmpValue2 = Replace(TmpValue2, "z","") TmpValue2 = Replace(TmpValue2, "A","") TmpValue2 = Replace(TmpValue2, "B","") TmpValue2 = Replace(TmpValue2, "C","") TmpValue2 = Replace(TmpValue2, "D","") TmpValue2 = Replace(TmpValue2, "E","") TmpValue2 = Replace(TmpValue2, "F","") TmpValue2 = Replace(TmpValue2, "G","") TmpValue2 = Replace(TmpValue2, "H","") TmpValue2 = Replace(TmpValue2, "I","") TmpValue2 = Replace(TmpValue2, "J","") TmpValue2 = Replace(TmpValue2, "K","") TmpValue2 = Replace(TmpValue2, "L","") TmpValue2 = Replace(TmpValue2, "M","") TmpValue2 = Replace(TmpValue2, "N","") TmpValue2 = Replace(TmpValue2, "O","") TmpValue2 = Replace(TmpValue2, "P","") TmpValue2 = Replace(TmpValue2, "Q","") TmpValue2 = Replace(TmpValue2, "R","") TmpValue2 = Replace(TmpValue2, "S","") TmpValue2 = Replace(TmpValue2, "T","") TmpValue2 = Replace(TmpValue2, "U","") TmpValue2 = Replace(TmpValue2, "V","") TmpValue2 = Replace(TmpValue2, "W","") TmpValue2 = Replace(TmpValue2, "X","") TmpValue2 = Replace(TmpValue2, "Y","") TmpValue2 = Replace(TmpValue2, "Z","") TmpValue2 = Replace(TmpValue2, "0","") TmpValue2 = Replace(TmpValue2, "1","") TmpValue2 = Replace(TmpValue2, "2","") TmpValue2 = Replace(TmpValue2, "3","") TmpValue2 = Replace(TmpValue2, "4","") TmpValue2 = Replace(TmpValue2, "5","") TmpValue2 = Replace(TmpValue2, "6","") TmpValue2 = Replace(TmpValue2, "7","") TmpValue2 = Replace(TmpValue2, "8","") TmpValue2 = Replace(TmpValue2, "9","") TmpValue2 = Replace(TmpValue2, "-","") TmpValue2 = Replace(TmpValue2, "_","") If TmpValue2 <> "" Then bCheck = 7 Exit For End If If Len("" & TmpContent(ii)) > 12 Then 'パスワード文字数オーバー bCheck = 8 Exit For End If End If Next If bCheck = "true" Then ReDim PreServe TmpRow(UBound(TmpRow) + 1) '配列を追加 TmpRow(UBound(TmpRow)) = "" For ii = 0 to 3 If TmpRow(UBound(TmpRow)) <> "" Then TmpRow(UBound(TmpRow)) = TmpRow(UBound(TmpRow)) & "," End If TmpRow(UBound(TmpRow)) = TmpRow(UBound(TmpRow)) & Replace("" & TmpContent(ii), ",", ",") Next End If Content.MoveNext Loop Dim TmpCol Dim Query2 For ii = 1 To UBound(TmpRow) TmpCol = Split(TmpRow(ii), ",") Query = "exec SPMユーザー更新 '" & GB_SystemCD & "', 1" Query = Query & ", '" & TmpCol(0) & "'" Query = Query & ", '" & TmpCol(1) & "'" Query = Query & ", '" & TmpCol(2) & "'" Query = Query & ", '" & TmpCol(3) & "'" Query = Query & ", '" & GroupCD & "'" Set Content = ExecQuery(db, Query) Next Response.Redirect(Replace(Url, "excel_bin", "ikkatsu") & "?Excel=Excel") End Sub %>