<% ' %> <% main() Sub main() Dim Sheet Dim Header Dim GroupCD Sheet = Request("Sheet") Header = Request("Header") GroupCD = Request("GroupCD") Dim fs, obj Dim ExcelDir Dim a, b, f1, fsize1, l1, FileName ExcelDir = "/" & HomeAlias & "/data/user" FileName = "userdata.xls" 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 On Error Resume Next Err.Clear() rs.Open ExcelConnection If Err.Description <> "" Then Response.Write("エラーが発生しました。
選択されたファイルに異常があるようです。

") Response.Write("エラーコード：") Response.Write(Err.Description) Response.Write("

") Response.Write("戻る") Exit Sub End If Err.Clear() Set Content = rs.Execute(Query) If Err.Description <> "" Then If InStr(Err.Description, Sheet & "$") > 0 Then Response.Write("エラーが発生しました。
Excelデータ内に指定されたシートが存在しない可能性があります。") Else Response.Write("エラーが発生しました。
サーバーの Microsoft Excel Driver に異常があるようです。

") Response.Write("エラーコード：") Response.Write(Err.Description) End If Response.Write("

") Response.Write("戻る") Exit Sub End If On Error Goto 0 'クエリ結果待機処理（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 Bad0Row 'バッドエントリ ReDim Bad0Row(0) '(0)は予備配列として実際の処理では捨てる Bad0Row(UBound(Bad0Row)) = "" Dim Bad1Row 'ユーザーID重複 ReDim Bad1Row(0) '(0)は予備配列として実際の処理では捨てる Bad1Row(UBound(Bad1Row)) = "" Dim Bad2Row 'リスト内ユーザーID重複 ReDim Bad2Row(0) '(0)は予備配列として実際の処理では捨てる Bad2Row(UBound(Bad2Row)) = "" Dim Bad3Row 'ユーザーID不正文字 ReDim Bad3Row(0) '(0)は予備配列として実際の処理では捨てる Bad3Row(UBound(Bad3Row)) = "" Dim Bad4Row 'ユーザーID文字数オーバー ReDim Bad4Row(0) '(0)は予備配列として実際の処理では捨てる Bad4Row(UBound(Bad4Row)) = "" Dim Bad5Row '氏名文字数オーバー ReDim Bad5Row(0) '(0)は予備配列として実際の処理では捨てる Bad5Row(UBound(Bad5Row)) = "" Dim Bad6Row '略氏名文字数オーバー ReDim Bad6Row(0) '(0)は予備配列として実際の処理では捨てる Bad6Row(UBound(Bad6Row)) = "" Dim Bad7Row 'パスワード不正文字 ReDim Bad7Row(0) '(0)は予備配列として実際の処理では捨てる Bad7Row(UBound(Bad7Row)) = "" Dim Bad8Row 'パスワード文字数オーバー ReDim Bad8Row(0) '(0)は予備配列として実際の処理では捨てる Bad8Row(UBound(Bad8Row)) = "" Dim Bad9Row 'グループ未存在 ReDim Bad9Row(0) '(0)は予備配列として実際の処理では捨てる Bad9Row(UBound(Bad9Row)) = "" Dim ii Dim jj Dim bCheck bCheck = 3 Dim TmpValue Dim TmpRowValue Dim TmpValue2 Dim TmpContent(5) If Content.Fields.Count > 2 Then '要素を配列に変換 Do While Not(Content.EOF Or Content.BOF) TmpContent(0) = Trim(ConvProhiStr("" & Content(0))) TmpContent(1) = Trim(ConvProhiStr("" & Content(1))) TmpContent(2) = Trim(ConvProhiStr(Replace("" & Content(2), ",", ""))) TmpContent(3) = Trim(ConvProhiStr(Replace("" & Content(3), ",", ""))) 'Response.Write(TmpContent(3)) If Content.Fields.Count > 4 Then TmpContent(4) = Trim(ConvProhiStr("" & Content(4))) End If bCheck = "true" For ii = 0 to 4 If (ii <> 3 And ii <> 4) And ("" & TmpContent(ii) = "" Or "" & TmpContent(ii) = " " Or "" & TmpContent(ii) = "　") Then 'バッドエントリ bCheck = 0 Exit For End If If ii = 0 Then If AscLen("" & TmpContent(ii)) > 40 Then '名称文字数オーバー bCheck = 1 End If End If If ii = 1 Then If AscLen("" & TmpContent(ii)) > 20 Then '略名称文字数オーバー bCheck = 2 End If End If If ii = 2 Then If Not(IsNumeric("" & TmpContent(ii))) Then '定価NaN bCheck = 3 End If If Len("" & TmpContent(ii)) > 10 Then '定価文字数オーバー bCheck = 4 Exit For End If End If If ii = 3 Then If "" & TmpContent(ii) <> "" And Not(IsNumeric("" & TmpContent(ii))) Then '税率NaN bCheck = 5 End If If "" & TmpContent(ii) <> "" And Len("" & TmpContent(ii)) > 5 Then '税率文字数オーバー bCheck = 6 Exit For End If End If If ii = 4 Then If AscLen("" & TmpContent(ii)) > 40 Then 'カテゴリ文字数オーバー bCheck = 7 End If End If Next If "" & bCheck = "true" Then ReDim PreServe TmpRow(UBound(TmpRow) + 1) '配列を追加 TmpRow(UBound(TmpRow)) = "" For ii = 0 to 4 If TmpRow(UBound(TmpRow)) <> "" Then TmpRow(UBound(TmpRow)) = TmpRow(UBound(TmpRow)) & "," End If TmpRow(UBound(TmpRow)) = TmpRow(UBound(TmpRow)) & Replace("" & TmpContent(ii), ",", "，") Next TmpRow(UBound(TmpRow)) = TmpRow(UBound(TmpRow)) & ",dummy" ElseIf bCheck = 7 Then ReDim PreServe Bad7Row(UBound(Bad7Row) + 1) '配列を追加（カテゴリ文字数オーバー） Bad7Row(UBound(Bad7Row)) = "" For ii = 0 to 4 If Bad7Row(UBound(Bad7Row)) <> "" Then Bad7Row(UBound(Bad7Row)) = Bad7Row(UBound(Bad7Row)) & "," End If Bad7Row(UBound(Bad7Row)) = Bad7Row(UBound(Bad7Row)) & Replace("" & TmpContent(ii), ",", "，") Next ElseIf bCheck = 6 Then ReDim PreServe Bad6Row(UBound(Bad6Row) + 1) '配列を追加（税率文字数オーバー） Bad6Row(UBound(Bad6Row)) = "" For ii = 0 to 4 If Bad6Row(UBound(Bad6Row)) <> "" Then Bad6Row(UBound(Bad6Row)) = Bad6Row(UBound(Bad6Row)) & "," End If Bad6Row(UBound(Bad6Row)) = Bad6Row(UBound(Bad6Row)) & Replace("" & TmpContent(ii), ",", "，") Next ElseIf bCheck = 5 Then ReDim PreServe Bad5Row(UBound(Bad5Row) + 1) '配列を追加（税率NaN） Bad5Row(UBound(Bad5Row)) = "" For ii = 0 to 4 If Bad5Row(UBound(Bad5Row)) <> "" Then Bad5Row(UBound(Bad5Row)) = Bad5Row(UBound(Bad5Row)) & "," End If Bad5Row(UBound(Bad5Row)) = Bad5Row(UBound(Bad5Row)) & Replace("" & TmpContent(ii), ",", "，") Next ElseIf bCheck = 4 Then ReDim PreServe Bad4Row(UBound(Bad4Row) + 1) '配列を追加（定価文字数オーバー） Bad4Row(UBound(Bad4Row)) = "" For ii = 0 to 4 If Bad4Row(UBound(Bad4Row)) <> "" Then Bad4Row(UBound(Bad4Row)) = Bad4Row(UBound(Bad4Row)) & "," End If Bad4Row(UBound(Bad4Row)) = Bad4Row(UBound(Bad4Row)) & Replace("" & TmpContent(ii), ",", "，") Next ElseIf bCheck = 3 Then ReDim PreServe Bad3Row(UBound(Bad3Row) + 1) '配列を追加（定価NaN） Bad3Row(UBound(Bad3Row)) = "" For ii = 0 to 4 If Bad3Row(UBound(Bad3Row)) <> "" Then Bad3Row(UBound(Bad3Row)) = Bad3Row(UBound(Bad3Row)) & "," End If Bad3Row(UBound(Bad3Row)) = Bad3Row(UBound(Bad3Row)) & Replace("" & TmpContent(ii), ",", "，") Next ElseIf bCheck = 2 Then ReDim PreServe Bad2Row(UBound(Bad2Row) + 1) '配列を追加（略名称文字数オーバー） Bad2Row(UBound(Bad2Row)) = "" For ii = 0 to 4 If Bad2Row(UBound(Bad2Row)) <> "" Then Bad2Row(UBound(Bad2Row)) = Bad2Row(UBound(Bad2Row)) & "," End If Bad2Row(UBound(Bad2Row)) = Bad2Row(UBound(Bad2Row)) & Replace("" & TmpContent(ii), ",", "，") Next ElseIf bCheck = 1 Then ReDim PreServe Bad1Row(UBound(Bad1Row) + 1) '配列を追加（名称文字数オーバー） Bad1Row(UBound(Bad1Row)) = "" For ii = 0 to 4 If Bad1Row(UBound(Bad1Row)) <> "" Then Bad1Row(UBound(Bad1Row)) = Bad1Row(UBound(Bad1Row)) & "," End If Bad1Row(UBound(Bad1Row)) = Bad1Row(UBound(Bad1Row)) & Replace("" & TmpContent(ii), ",", "，") Next Else ReDim PreServe Bad0Row(UBound(Bad0Row) + 1) '配列を追加（バッドエントリ） Bad0Row(UBound(Bad0Row)) = "" For ii = 0 to 4 If Bad0Row(UBound(Bad0Row)) <> "" Then Bad0Row(UBound(Bad0Row)) = Bad0Row(UBound(Bad0Row)) & "," End If Bad0Row(UBound(Bad0Row)) = Bad0Row(UBound(Bad0Row)) & Replace("" & TmpContent(ii), ",", "，") Next End If Content.MoveNext Loop End If Dim TmpCol Dim TmpCol2 Response.AddHeader "Content-Type", "text/html; charset=Shift_JIS" '文字化け対策 %> <% = HtmlHeader("") %>
<% Response.Write(HtmlDesign(8)) Response.Write(HttpL1(4)) Response.Write(HttpL2("運用管理メニュー" ,"tblbtn( '/" & HomeAlias & "/admin/admenu_w.asp')", "ユーザー管理", "", "", "", "", "", "", "", "", "")) Response.Write(HttpL3_2("戻る", "", "", "", "", "", "", "", "", "")) Response.Write(HttpL3("", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "")) Response.Write(HttpL3_1("", "", "", "", "", "", "", "", "", "")) Response.Write(HttpL4("ユーザー管理", "Excelデータのインポート")) Response.Write(HttpL5("全てのユーザーを表示しています。")) %>
<% = HtmlFooter %> <% End Sub %>