ASP中上传EXCEL,再把EXCEL导入到SQL中的例子,带上传功能

更新时间:2023-07-13 13:19:00 阅读: 评论:0

<--default.asp-->
<html>
<head>
<title>EXCEL数据库导入系统</title>
<meta http-equiv="Content-Type" content="text/html; chart=gb2312">
rain是什么意思
<link href="../css/sport_style.css" rel="stylesheet" type="text/css">
</head>
<body class="h2">
<form action="result.asp" method="post" enctype="multipart/form-data" name="form1">
<table width="80%" border="0" align="center" cellpadding="1" cellspacing="0">
<tr>
<td bgcolor="#6d6d6d"><table width="100%" border="0" cellspacing="0" cellpadding="1"bordercolorlight="#ffffff" bordercolordark="#FFFFFF" bgcolor="#FFFFFF">
<tr>
成分英语<td><table width="100%" border="0" cellpadding="1" cellspacing="0" class="text">
<tr>
<td bgcolor="#7d7d7d"><table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#ffffff">
<tr>
<td align="center"><strong>EXCEL数据转换</strong><br> <table width="60%" border="1" align="center" cellpadding="0" cellspacing="0" bordercolorlight="#CBDFF3" bordercolordark="#FFFFFF" class="P093">
<tr>
<td align="center" bgcolor="#CBDFF3"><font size="2">所要上传的EXCEL信息文件(.xls)</font></td>
<td> <input name="fruit" type="file" class="buttonface" id="fruit"></td>
</tr>
<tr>
<td width="33%" height="15" align="center" bgcolor="#CBDFF3"><font size="2">要转换的EXCEL的SHEET的表名称 
</font></td>
<td width="67%" height="15"><input name="tables1" type="text" class="buttonface" id="tables1" size="16" maxlength="30"></td>
</tr>
<tr>
<td height="15" align="center" bgcolor="#CBDFF3"><font size="2">单位缩写</font></td>
<td width="67%" height="15"> <input name="bank" type="text" id="bank"></td>
</tr>
</table>
<br> <p> </p>
<p> </p>
<p>
<input name="Submit" type="submit" class="button" id="Submit2" value="完成">
<input name="Submit2" type="ret" class="button" id="Submit2" value="重写">
<br>
</p></td>
</tr>
</table></td>
</tr>
</table></td>
living in a big city
</tr>
</table></td>
</tr>
</table>
</form>
</body>
</html>
<--result.asp-->
<!--#i nclude file="uploadx.asp"-->
<%
'on error resume next
Dim filePath
Dim fileName
Dim fileExt
Dim file_subject
Dim Sql
Dim msg
Di
m errflag
Dim errnumber
Dim SavePath
Dim maxfilesize
SavePath = "file"        '虚拟路径(后面不要加"/"符号)
maxfilesize = 50*1024        '大小为50M
Errflag=fal
filePath = SavePath          '使用虚拟路径进行赋值,如"/www"或"www"等
filePath = Server.MapPath(filePath)      '将虚拟路径转换为磁盘路径
file_subject = GetFormVal("tables1")    '取得文件标题
fileext = GetFormVal("bank")      '取得文件介绍
errnumber = GetFormVal("errnumber")      '取得报错方式
filename = SaveFile("fruit",filePath,maxfilesize,2,1) '保存并取得文件名
' 0,1  唯一文件名方式,如果有同名则自动改名;
' 1,1  报错方式,如果有同名则出错;
' 2,[0|1]  覆盖方式,如果有同名则覆盖原来的文件
sheet = file_subject
bank = fileext
dim conn
dim conn2
dim filename_2
dim count_num
filename_2 = Split(filename,"|")
'On Error Resume Next
db="\file\"&filename_2(0)
Server.ScriptTimeOut = 999999
t conn=CreateObject("ADODB.Connection")
conn.Open "driver={SQL Server};rver=rver2003;uid=sa;pwd=;databa=exceltest;" '导入的数据库名称
del_sql="delete from test" ' 先清空表里面的数据
count_num=0
Set conne = Server.CreateObject("ADODB.Connection")
Driver = "Driver={Microsoft Excel Driver (*.xls)};"
DBPath = "DBQ=" &Server.MapPath(""&db&"")
' 调用Open 方法打开excel
conne.Open Driver & DBPath
Set r = Server.CreateObject("ADODB.Recordt")
' 打开Sheet,参数二为Connection对象,因为Excel ODBC驱动程序无法直接用'sheet名来打开sheet,所以请注意以下的lect语句
r.Open "Select *  From ["&sheet&"$]", conne
while f
sql = "inrt into test (name_a,x) values('"& fixsql(r(0)) &"','"& fixsql(r(1)) &"')"
'Respon.Write "正在插入 "&sql&"<Br>"
count_num=count_num+1
Respon.Flush
wend
conn.clo
t conn = nothing
conne.clo
t conn2 = Nothing
If Err = 0 Then
'Respon.Write "成功导入"&count_num&"条记录"
El
Respon.Write "导入失败!"
End If
function fixsql(str)
dim newstr
newstr = str
if isnull(newstr) then
newstr = ""
el
newstr = replace(newstr,"'","''")
end if
fixsql = newstr
end Function
%>
<html>
<head>
<title>导入成功</title>
<meta http-equiv="Content-Type" content="text/html; chart=gb2312">
<link href="/css/sport_style.css" rel="stylesheet" type="text/css">
</head>
<body class="h1">
<table width="700" border="0" cellspacing="0" cellpadding="1" align="center">
<tr>
<td> <table width="100%" border="0" cellspacing="0" cellpadding="0"  >
<tr>
<td>  </td>
</tr>
<tr>
<td> <div align="center">
<table width="600" border="0" cellpadding="0" cellspacing="0" bgcolor="#CBDFF3">
<tr>
<td width="15" height="15"> </td>
<td    width="570"></td>
<td width="15" height="15"> </td>
</tr>
<tr>
<td colspan="3"> <div align="center">
偏差
<table width="599" border="0" cellspacing="0" cellpadding="0">
<tr>
<td class="P093"> <div align="center">
<center>
</center>
</div></td>
</tr>
<tr>
<td class="P093"> <div align="center">
<hr width=500>
</div></td>
</tr>
<tr>
<td class="P093"> <div align="center">
<p><font size="2"><%respon.Write "数据导入完毕,共导入"&count_num&"条记录"%></font></p>
<p> </p>
</div></td>
</tr>
<tr>
<td class="P093"> <div align="center">
<hr width=500>
</div></td>
</tr>
<tr>
<td class="P093"> <div align="center"> <font color="#FFFFFF">  
</font> </div></td>
</tr>
</table>
</div></td>
</tr>
<tr>
<td width="15" height="15"> </td>
<td    width="570"></td>
astonmartin<td width="15" height="15"> </td>
</tr>
</table>
</div></td>
</tr>
<tr>
<td>  </td>
</tr>
</table></td>
</tr>
</table>
</body>
</html>
<--uploadx.asp-->
<%
Dim FormData, FormSize, Divider, bCrLf
Dim FixFileExt
FormSize = Request.TotalBytes
FormData = Request.BinaryRead(FormSize)
bCrLf = ChrB(13) & ChrB(10)
Divider = LeftB(FormData, InStrB(FormData, bCrLf) - 1)
FixFileExt="asp|aspx|asa|asax|ascx|ashx|asmx|axd|cdx|cer|config|cs|csproj|licx|rem|resx|shtml|shtm|soap|stm|vb|vbproj|webinfo|cgi|pl|php|phtml|php3"  '限制为只有这些文件可以上传(用"|"号格开)
Function SaveFile(FormFileField, Path, MaxSize, SavType, FsoType)
If (SavType=0 or SavType=1) and FsoType=0 then
SaveFile = "modeError"
Exit function
End if
Dim ObjStream,Allyes_ObjStream
Dim StartPos
Dim Strlen, SearchStr
Dim FileStart, FileLen, FileContent
Dim Re_SavType
Dim fnN
Dim intfnN
Dim FileExtName
Dim FixFnN
Dim intFix
Dim i
Set ObjStream = Server.CreateObject("ADODB.Stream")
Set Allyes_ObjStream = Server.CreateObject("ADODB
.Stream")
ObjStream.Mode = 3
ObjStream.Type = 1
Allyes_ObjStream.Mode = 3
Allyes_ObjStream.Type = 1
SaveFile = ""
StartPos = LenB(Divider) + 2
FormFileField = Chr(34) & FormFileField & Chr(34)
'-----------------------------------检测路径------------------------------------
If Right(Path,1) <> "\" Then  '检测目录参数的完整性
Path = Path & "\"
End If
If FsoType = 1 then    '如果支持FSO则检测。否则不检测
CheckPath(path)    '检测指定目录是否存在,如果不存在,则自行创建
End if
'-------------------------------------------------------------------------------
If len(trim(MaxSize)) = 0 then
MaxSize=50*1024    '指定默认最大上传文件为50M
End if
Do While StartPos > 0    '开始保存每个file文件对象数据
strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormFileField) > 0 Then
FileName = bin2str(GetFileName(SearchStr,path,SavType,FsoType))
filename=year(now())&month(now())&day(now())&hour(now())&minute(now())&cond(now())&".xls"
''----------------文件格式限制------------------------
fnN = split(fileName,".")
intfnN = Ubound(fnN)
FileExtName = trim(fnN(intfnN))
FixFnN = Split(FixFileExt,"|")
intFix = Ubound(FixFnN)
for i = 0 to intFix
if lca(FileExtName) = lca(trim(FixFnN(i))) then
SaveFile = "fileError"
exit do
end if
next
'------------------------------------------------------
If FileName <> "" Then
FileStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
FileLen = InStrB(StartPos, FormData, Divider) - 2 - FileStart
If FileLen <= MaxSize*1024 Then
FileContent = MidB(FormData, FileStart, FileLen)
Allyes_ObjStream.Open
With ObjStream
.Open
.Write FormData
.Position=FileStart-1
.
CopyTo Allyes_ObjStream,FileLen
End With
Re_SavType = SavType
If SavType = 0 Then
SavType = 1
End If
On error resume next
Allyes_ObjStream.SaveToFile Path & FileName, SavType
if err.number<>0 then
If Re_SavType=0 or Re_SavType=2 then
FileName="pathError"
el
FileName="refileError"
end if
end if
ObjStream.Clo
Allyes_ObjStream.Clo
rubinaIf SaveFile <> "" Then
SaveFile = "" & ","  & FileName &"|"& FileLen
El
SaveFile = FileName &"|"& FileLen
End If
El
If SaveFile <> "" Then
SaveFile = SaveFile & ",re
fileError"
El
SaveFile = "sizeError"
End If
darling i want you
End If
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function
Function GetFormVal(FormName)      '取得如果是表单项目的过程
Dim StartPos
Dim Strlen, SearchStr
Dim ValStart, ValLen, ValContent
GetFormVal = ""
StartPos = LenB(Divider) + 2
FormName = Chr(34) & FormName & Chr(34)
Do While StartPos > 0
Strlen = InStrB(StartPos, FormData, bCrLf) - StartPos
SearchStr = MidB(FormData, StartPos, strlen)
If InStr(bin2str(SearchStr), FormName) > 0 Then
ValStart = InStrB(StartPos, FormData, bCrLf & bCrLf) + 4
ValLen = InStrB(StartPos, FormData, Divider) - 2 - ValStart
ValContent = MidB(FormData, ValStart, ValLen)
If GetFormVal <> "" Then
GetFormVal = GetFormVal & "," & bin2str(ValContent)
El
GetFormVal = bin2str(ValContent)
End If
End If
If InStrB(StartPos, FormData, Divider) < 1 Then
Exit Do
End If
StartPos = InStrB(StartPos, FormData, Divider) + LenB(Divider) + 2
Loop
End Function
Function bin2str(binstr)
price是什么意思Dim BytesStream,StringReturn
Set BytesStream = Server.CreateObject("ADODB.Stream")
With BytesStream
.Type = 2
.Open
.WriteText binstr
.Position = 0
.Chart = "GB2312"
.Position = 2
StringReturn = .ReadText
.clo
End With
Set BytesStream = Nothing
bin2str = StringReturn
End Function
Function str2bin(str)
Dim i
For i = 1 To Len(str)
英语范文str2bin = str2bin & ChrB(Asc(Mid(str, i, 1)))
Next
End Function
Function GetFileName(str,path,savtype,fsotype)
Dim fs
Dim i
Dim hFileName
Dim rFileName
str = RightB(str,LenB(str)-InstrB(str,str2bin("filename="))-9)
GetFileName = ""
FileName = ""
For i = LenB(str) To 1 Step -1
If MidB(str, i, 1) = ChrB(Asc("\")) Then
FileName = MidB(str, i + 1, LenB(str) - i - 1)
Exit For
yaz flex
End If
Next
If fsotype=1 then        '如果支持FSO,则执行FSO过程
Set fs = Server.CreateObject("Scripting.FileSystemObject")
If savtype = 0 and fs.FileExists(path & bin2str(FileName)) = True Then
hFileName = FileName
rFileName = ""
For i = LenB(FileName) To 1 Step -1
If MidB(FileName, i, 1) = ChrB(Asc(".")) Then
hFileName = LeftB(FileName, i-1)
rFileName = RightB(FileName, LenB(FileName)-i+1)
Exit For
End If
Next
For i = 0 to 9999
If fs.FileExists(path & bin2str(hFileName) & i & bin2str(rFileName)) = Fal Then
FileName = hFileName & str2bin(i) & rFileName
Exit For

本文发布于:2023-07-13 13:19:00,感谢您对本站的认可!

本文链接:https://www.wtabcd.cn/fanwen/fan/78/1094360.html

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系,我们将在24小时内删除。

标签:文件   导入   取得   路径   检测   方式
相关文章
留言与评论(共有 0 条评论)
   
验证码:
推荐文章
排行榜
Copyright ©2019-2022 Comsenz Inc.Powered by © 专利检索| 网站地图