
<!-- #include file="../../../include.asp" -->

<%
'<!--
'################################################
'	 名称	：Excelファイルから商品取り込み
'	 作成日	：2020/12/15
'	 作成者	：小野
'	 目的	：
'	 概要	：
'################################################
'-->
%>
<%
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

If BASPLEADDisable = 1 Then 'ASP.NETモードではJETが使えない(Access2010再頒布可能パッケージのインストールが必要)
	ExcelConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Server.MapPath(ExcelDir) & "\" & FileName & ";Extended Properties="
Else
	ExcelConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(ExcelDir) & "\" & FileName & ";Extended Properties="
End If
	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) = 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 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"
		End If
		Content.MoveNext
	Loop


	Dim TmpCol
	Dim Query2

	Dim TmpID
	TmpID = 0
	For ii = 1 To UBound(TmpRow)
		For jj = TmpID To 9999
			'採番
			Query = "exec SPM商品取得 '" & GB_SystemCD & "','" & EnshuCD & "','" & Right("000" & jj, 4) & "'"
			Set Content = ExecQuery(db, Query)
'			Set Content = OpenQuery(Query)
			If Content.EOF Or Content.BOF Then
				TmpID = jj
				Exit For
			End If
		Next
		TmpCol = Split(TmpRow(ii), ",")
		Query = "exec SPM商品更新 '" & GB_SystemCD & "', 1"
		Query = Query & ", '" & EnshuCD &	"'"
		Query = Query & ", '" & Right("000" & TmpID, 4) & "'"
		Query = Query & ", ''"
		Query = Query & ", '" & TmpCol(0) & "'"
		Query = Query & ", '" & TmpCol(1) & "'"
		Query = Query & ", ''"
		Query = Query & ", " & TmpCol(2) & " "
		Query = Query & ", 0"
		Query = Query & ", 0"
		Query = Query & ", 0"
		Query = Query & ", 0"
		Query = Query & ", 0"
		Query = Query & ", ''"
		Query = Query & ", ''"
		Query = Query & ", ''"
		Query = Query & ", null"
		Query = Query & ", 1"							'作成区分＝１（運用管理作成データ）をセット
		Query = Query & ", ''"
		Set Content = ExecQuery(db, Query)
		If TmpCol(3) <> "" Or TmpCol(4) <> "" Then
			'カテゴリ更新
			Query = ""
			Query = Query & "  "
			Query = Query & " UPDATE TDA商品M "
			Query = Query & " SET カテゴリ = '" & TmpCol(4) & "' "
			If "" & TmpCol(3) <> "" Then
				'標準消費税率更新
				Query = Query & " 	, 標準消費税率 = " & TmpCol(3) & " "
			End If
			Query = Query & " WHERE システムCD = '" & GB_SystemCD & "' "
			Query = Query & " 	AND 演習CD = '" & EnshuCD & "' "
			Query = Query & " 	AND 商品CD = '" & Right("000" & TmpID, 4) & "' "
			Set Content = OpenQuery(Query)
		End If
		TmpID = TmpID + 1
	Next

	Response.Redirect(Replace(Url, "excel_bin", "ichiran"))


End Sub
%>