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

最新推荐文章于 2022-01-20 14:10:16 发布

fadfayger

最新推荐文章于 2022-01-20 14:10:16 发布

阅读量1.1k

点赞数

分类专栏： Excel导入开发技术

开发技术同时被 2 个专栏收录

10 篇文章 0 订阅

订阅专栏

Excel导入

1 篇文章 0 订阅

订阅专栏

<--default.asp-->

<html>
<head>
<title>EXCEL数据库导入系统</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</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="reset" class="button" id="Submit2" value="重写">
                            <br>
                          </p></td>
                      </tr>
                    </table></td>
                </tr>
              </table></td>
          </tr>
        </table></td>
    </tr>
  </table>
</form>
</body>
</html>

<--result.asp-->

<!--#include file="uploadx.asp"-->
<%
on error resume next
Dim filePath
Dim fileName
Dim fileExt
Dim file_subject
Dim Sql
Dim msg
Dim errflag
Dim 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&"<Br>"
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
%>
<html>
<head>
<title>导入成功</title>
<meta http-equiv="Content-Type" content="text/html; charset=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"><%response.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>
                  <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())&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 & ",refileError"
                    Else
                        SaveFile = "sizeError"
                    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
    End If
   Next
  End If
  Set fs = Nothing
 End If
 GetFileName = FileName
End Function

Function CheckPath(path)        '检测该目录是否存在，如果不存在，则建立该目录
 Dim Fs
 set Fs=server.CreateObject("scripting.filesystemobject")
 if not fs.FolderExists(path) then
  Fs.CreateFolder(path)
 end if
 set Fs = nothing
End function
%>