%
'
%>
<%
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("") %>