<!-- #include file="../../include.asp" -->
<%
'<!--
'################################################
' 名称 ：ユーザー一括更新
' 作成日 ：2007/3/20
' 作成者 ：小野
' 目的 ：ユーザーを一括更新・追加する。
' 概要 ：
' <<表示>>
' <<入力チェック>>
' ・ＮＵＬＬチェック
'
' 修正:
'################################################
'-->
%>
<%
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
%>