<% ' %> <% 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) = 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" '作成区分=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 %>