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

<--default.asp-->

EXCEL数据转换 所要上传的EXCEL信息文件(.xls) 要转换的EXCEL的SHEET的表名称 单位缩写

<--result.asp-->




<%


'on error resume next
Dim filePath
Dim fileName
Dim fileExt
Dim file_subject
Dim Sql
Dim msg
D

iDim errnumber
Dim SavePath
Dim maxfilesize

SavePath = "file" '虚拟路径(后面不要加"/"符号)
maxfilesize = 50*1024 '大小为50M

Errflag=false
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
set conn=CreateObject("ADODB.Connection")
conn.Open "driver={SQL Server};server=server2003;uid=sa;pwd=;database=exceltest;" '导入的数据库名称


del_sql="delete from test" ' 先清空表里面的数据
conn.execute(del_sql)
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 rse = Server.CreateObject("ADODB.Recordset")
' 打开Sheet，参数二为Connection对象,因为Excel ODBC驱动程序无法直接用'sheet名来打开sheet,所以请注意以下的select语句

rse.Open "Select * From ["&sheet&"$]", conne
while not rse.eof
sql = "insert into test (name_a,sex) values('"& fixsql(rse(0)) &"','"& fixsql(rse(1)) &"')"
conn.execute(sql)
rse.movenext
'Response.Write "正在插入 "&sql&"
"
count_num=count_num+1
Response.Flush
wend


conn.close
set conn = nothing
conne.close
set conn2 = Nothing

If Err = 0 Then
'Response.Write "成功导入"&count_num&"条记录"

Else
Response.Write "导入失败!"
End If

function fixsql(str)
dim newstr
newstr = str
if isnull(newstr) then
newstr = ""
else
newstr = replace(newstr,"'","''")
end if
fixsql = newstr
end Function
%>

<%response.Write "数据导入完毕,共导入"&count_num&"条记录"%>

<--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 ObjStream.Mode = 3
ObjStream.Type = 1
Al

lyes_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())&second(now())&".xls"

''----------------文件格式限制------------------------
fnN = split(fileName,".")
intfnN = Ubound(fnN)
FileExtName = trim(fnN(intfnN))
FixFnN = Split(FixFileExt,"|")
intFix = Ubound(FixFnN)
for i = 0 to intFix
if lcase(FileExtName) = lcase(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"
else
FileName="refileError"
end if
end if
ObjStream.Close
Allyes_ObjStream.Close

If SaveFile <> "" Then
SaveFile = "" & "," & FileName &"|"& FileLen
Else
SaveFile = FileName &"|"& FileLen
End If
Else
If SaveFile <> "" Then
SaveFile = SaveFile & ",re Else
SaveFile = "siz

eError"
End If
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)
Else
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)
Dim BytesStream,StringReturn

Set BytesStream = Server.CreateObject("ADODB.Stream")
With BytesStream
.Type = 2
.Open
.WriteText binstr
.Position = 0
.Charset = "GB2312"
.Position = 2
StringReturn = .ReadText
.close
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
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)) = False Then
FileName = hFileName & str2bin(i) & rFileName
Exit For
Next
End If
Set fs = Nothing
End If
GetFileName = FileName
End