<% ' %> <% main() Sub main() Dim Sheet Dim Header Dim fs, obj Dim ExcelDir Dim a, b, f1, fsize1, l1, FileName a=Request.TotalBytes On Error Resume Next Err.Clear() b=Request.BinaryRead(a) If Err.Description <> "" Then Response.Write("エラーが発生しました。
ファイルサイズが大きすぎる可能性があります。

") Response.Write("エラーコード:") Response.Write(Err.Description) Response.Write("

") Response.Write("戻る") Exit Sub End If On Error Goto 0 set obj=server.createobject("basp21") fsize1=obj.FormFileSize(b,"UpFile") Set fs = CreateObject("Scripting.FileSystemObject") ExcelDir = "/" & HomeAlias & "/data/user" If Not(fs.FolderExists(Server.MapPath(ExcelDir))) Then fs.CreateFolder(Server.MapPath(ExcelDir)) End If 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 のファイルのみです。

") ' Response.Write("戻る") ' 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 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) If InStr("" & Err.Description, "外部テーブルのフォーマットが正しくありません") > 0 Then Response.Write("

※Excel2007形式には対応していません。
※Excel2007上でExcel97-2003形式で保存してからインポートしてください。
") End If Response.Write("

") Response.Write("戻る") Exit Sub End If Err.Clear() 'スキーマテーブルに接続 Dim Sdb Set Sdb = rs.OpenSchema(20) If Sdb.EOF Or Sdb.BOF Then Response.Write("エラーが発生しました。
指定されたEXCELデータファイルが正しくない可能性があります。

") Response.Write("エラーコード:") Response.Write(Err.Description) Response.Write("

") Response.Write("戻る") Exit Sub End If On Error Goto 0 %> <% = HtmlHeader("") %>
<% 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("全てのユーザーを表示しています。")) %>
<% = HtmlFooter %> <% End Sub %>