<!-- #include file="../../include.asp" --> <% '<!-- '################################################ ' 名称 :ユーザー一括更新 ' 作成日 :2007/3/20 ' 作成者 :小野 ' 目的 :ユーザーを一括更新・追加する。 ' 概要 : ' <<表示>> ' <<入力チェック>> ' ・NULLチェック ' ' 修正: '################################################ '--> %> <% main() Sub main() Dim Sheet Dim Header Dim fs, obj Dim ExcelDir Dim a, b, f1, fsize1, l1, FileName Set fs = CreateObject("Scripting.FileSystemObject") ExcelDir = "/" & HomeAlias & "/data/user" If Not(fs.FolderExists(Server.MapPath(ExcelDir))) Then fs.CreateFolder(Server.MapPath(ExcelDir)) End If If BASPLEADDisable = 1 Then 'ASP.NETモードではBASP21を使わない f1 = Request("DNULFilename") Sheet = Request("Sheet") Header = Request("Header") FileName = "userdata.xls" On Error Resume Next fs.DeleteFile Server.MapPath(ExcelDir) & "\" & FileName fs.MoveFile Server.MapPath(ExcelDir) & "\" & f1, Server.MapPath(ExcelDir) & "\" & FileName On Error Goto 0 Else a=Request.TotalBytes On Error Resume Next Err.Clear() b=Request.BinaryRead(a) If Err.Description <> "" Then Response.Write("エラーが発生しました。<br>ファイルサイズが大きすぎる可能性があります。<br><br>") Response.Write("エラーコード:") Response.Write(Err.Description) Response.Write("<br><br>") Response.Write("<a href=""JavaScript:history.go(-1)"">戻る</a>") Exit Sub End If On Error Goto 0 set obj=server.createobject("basp21") fsize1=obj.FormFileSize(b,"UpFile") f1=obj.FormFileName(b,"UpFile") ' tmpEnshuCD = obj.Form(b,"tmpEnshuCD") ' tmpKaisyaCD = obj.Form(b,"tmpKaisyaCD") Sheet = obj.Form(b,"Sheet") Header = obj.Form(b,"Header") ' FileName=Mid(f1,InStrRev(f1,".")+1) '拡張子を取り出す ' If UCase(FileName) <> "XLS" Then ' Response.Write("読み込めるファイルは拡張子 .xls のファイルのみです。<br><br>") ' Response.Write("<a href=""JavaScript:history.go(-1)"">戻る</a>") ' Exit Sub ' End If ' FileName = "userdata." & FileName FileName = "userdata.xls" ' l1=obj.FormSaveAs(b,"UpFile",Server.MapPath(ExcelDir) & "\" & FileName) obj.FormSaveAs b,"UpFile",Server.MapPath(ExcelDir) & "\" & FileName End If 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 On Error Resume Next Err.Clear() rs.Open ExcelConnection If Err.Description <> "" Then Response.Write("エラーが発生しました。<BR>選択されたファイルに異常があるようです。<br><br>") Response.Write("エラーコード:") Response.Write(Err.Description) If InStr("" & Err.Description, "外部テーブルのフォーマットが正しくありません") > 0 Then Response.Write("<br><br>※Excel2007形式には対応していません。<br>※Excel2007上でExcel97-2003形式で保存してからインポートしてください。<br>") End If Response.Write("<br><br>") Response.Write("<a href=""JavaScript:history.go(-1)"">戻る</a>") Exit Sub End If Err.Clear() 'スキーマテーブルに接続 Dim Sdb Set Sdb = rs.OpenSchema(20) If Sdb.EOF Or Sdb.BOF Then Response.Write("エラーが発生しました。<BR>指定されたEXCELデータファイルが正しくない可能性があります。<br><br>") Response.Write("エラーコード:") Response.Write(Err.Description) Response.Write("<br><br>") Response.Write("<a href=""JavaScript:history.go(-1)"">戻る</a>") Exit Sub End If On Error Goto 0 %> <html> <% = HtmlHeader("") %> <SCRIPT LANGUAGE="JavaScript"> <!-- HomeAlias = "<% = HomeAlias %>"; HomeAliasSL = "<% = HomeAliasSL %>"; ExitFlg = 0; function SubmitCheck() { var errs = ""; if (document.form1.Sheet.value == "") { errs = "取り込み元シートを選択してください "; alert (errs); return false } if (document.form1.GroupCD.value == "") { errs = "対象グループを選択してください "; alert (errs); return false } document.form1.submit(); return true; } --> </SCRIPT> <body onkeydown="if(ExitFlg==2)ExitFlg=3;" onBeforeUnload="if(ExitFlg!=0)window.event.returnValue = ExitMsg(ExitFlg)" bgcolor="#5C70B6" text="#000000" leftmargin="0" topmargin="0" marginwidth="0" marginheight="0"> <form OnKeyDown="FormKeyDown(this)" method="POST" name="form1" action="fm_user_excel_ichiran.asp"> <input type="hidden" name="Header" value="<% = Header %>"> <% 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("全てのユーザーを表示しています。")) %> <div id="L0" style="position: absolute; visibility: hidden; left: 0px; top: -2000px;"> <table width="100%" height="100%" border="0" cellpadding="0" cellspacing="5"> <tr> <td valign="top"> <table border="0" cellpadding="5" cellspacing="0" width="100%" height="100%"> <tr> <td align="CENTER" valign="MIDDLE"> <TABLE BORDER="0" CELLSPACING="5" CELLPADDING="15" BGCOLOR="#FFFFFF" STYLE="BORDER:1px solid #000000" WIDTH="640" HEIGHT="100%"> <TR> <TD ALIGN="CENTER" BACKGROUND="/<% = HomeAlias %>/images/window_bk.gif?<% = GB_STU %>"> <TABLE WIDTH="670" BORDER="0" CELLSPACING="0" CELLPADDING="0" HEIGHT="100%"> <TR> <TD HEIGHT="100%" VALIGN="TOP" WIDTH="680"> <table border="0" width="100%" cellspacing="0" cellpadding="0" class="tx1416b"> <tr> <td> <% = Spacer(1,8) %> </td> </tr> <tr> <td align="right"> <img src="excel1.png?<% = GB_STU %>" border="1"> <BR><FONT COLOR="#FF0000"><B>シート名</B></FONT>はシート左下に表示されています </td> </tr> <tr> <td> <% = Spacer(1,8) %> </td> </tr> <tr> <td> <% 'シート一覧選択プルダウンメニューを出力 Response.Write(" Excelデータファイル内の取り込み元のシートを選択してください" & vbCrLf) Response.Write(" <select size=""1"" name=""Sheet"" class=""tbox4_w"" style=""width:260px;"">" & vbCrLf) ' Response.Write(" <option value="""">未選択</option>" & vbCrLf) 'スキーマテーブルの「TABLE_NAME」列を1レコードずつ読み出しループ Do While Not(Sdb.EOF Or Sdb.BOF) 'メニューオプションに書き出し Response.Write(" <option value=""" & Sdb.Fields("TABLE_NAME") & """") '現在表示すべきテーブルと同一ならデフォルト選択にする If "" & Sdb.Fields("TABLE_NAME") = Sheet Then Response.Write(" selected") End If ' Response.Write(">" & Left(Sdb.Fields("TABLE_NAME"), Len(Sdb.Fields("TABLE_NAME")) - 1) & "</option>" & vbCrLf) Response.Write(">" & Replace(Sdb.Fields("TABLE_NAME"), "$", "") & "</option>" & vbCrLf) Sdb.MoveNext Loop Response.Write("</select>" & vbCrLf) %> <br> <br> ユーザー作成対象グループを選択してください <select size="1" name="GroupCD" class="tbox4_w" style="width:360px;"> <option value=""> </option> <% Query = "exec SPMグループ一覧 '" & GB_SystemCD & "',''" Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) Response.Write("<option value=""" & Content.Fields("学生グループCD") & """>" & Content.Fields("グループ名称") & "</option>" & vbCrLf) Content.MoveNext Loop %> </select> <br> <br> <center> <input type="button" name="Import" value="データを解析する" onclick="SubmitCheck()"> <input type="button" name="Back" value="中止して戻る" onclick="history.go(-1)"> </center> </td> </tr> </TABLE> </td> </tr> </table> </TD> </TR> </TABLE> </td> </tr> </table> </td> </tr> </table> </div> </form> </body> <% = HtmlFooter %> </html> <% End Sub %>