唉，这个问题之前不是答了你的吗？在原有的基础上改动少少就可以了的啊！我就更改了点地方再贴一次吧，你看看跟之前的有哪些地方不同！ % sUploadDir = / '---------------------------------------------------------------------- Dim oUpFileStream '---------------------------------------------------------------------- '文件上传类 Class UpFile_Class Dim Form,File,Version,Err Private Sub Class_Initialize Version = 无惧上传类 Version V1.2 Err = -1 End Sub Private Sub Class_Terminate '清除变量及对像 If Err 0 Then Form.RemoveAll Set Form = Nothing File.RemoveAll Set File = Nothing oUpFileStream.Close Set oUpFileStream = Nothing End If End Sub Public Sub GetData (MaxSize) '定义变量 Dim RequestBinData,sSpace,bCrLf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,oFileInfo Dim iFileSize,sFilePath,sFileType,sFormValue,sFileName Dim iFindStart,iFindEnd Dim iFormStart,iFormEnd,sFormName '代码开始 If Request.TotalBytes 1 Then '如果没有数据上传 Err = 1 Exit Sub End If If MaxSize 0 Then '如果限制大小 If Request.TotalBytes MaxSize Then Err = 2 '如果上传的数据超出限制 Exit Sub End If End If Set Form = Server.CreateObject (Scripting.Dictionary) Form.CompareMode = 1 Set File = Server.CreateObject (Scripting.Dictionary) File.CompareMode = 1 Set tStream = Server.CreateObject (ADODB.Stream) Set oUpFileStream = Server.CreateObject (ADODB.Stream) oUpFileStream.Type = 1 oUpFileStream.Mode = 3 oUpFileStream.Open oUpFileStream.Write Request.BinaryRead (Request.TotalBytes) oUpFileStream.Position = 0 RequestBinData = oUpFileStream.Read iFormEnd = oUpFileStream.Size bCrLf = ChrB (13) & ChrB (10) '取得每个项目之间的分隔符 sSpace = MidB (RequestBinData,1, InStrB (1,RequestBinData,bCrLf)-1) iStart = LenB (sSpace) iFormStart = iStart+2 '分解项目 Do iInfoEnd = InStrB (iFormStart,RequestBinData,bCrLf & bCrLf)+3 tStream.Type = 1 tStream.Mode = 3 tStream.Open oUpFileStream.Position = iFormStart oUpFileStream.CopyTo tStream,iInfoEnd-iFormStart tStream.Position = 0 tStream.Type = 2 tStream.CharSet = gb2312 sInfo = tStream.ReadText '取得表单项目名称 iFormStart = InStrB (iInfoEnd,RequestBinData,sSpace)-1 iFindStart = InStr (22,sInfo,name=,1)+6 iFindEnd = InStr (iFindStart,sInfo,,1) sFormName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) '如果是文件 If InStr (45,sInfo,filename=,1) 0 Then Set oFileInfo = new FileInfo_Class '取得文件属性 iFindStart = InStr (iFindEnd,sInfo,filename=,1)+10 iFindEnd = InStr (iFindStart,sInfo,,1) sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart) oFileInfo.FileName = Mid (sFileName,InStrRev (sFileName, \)+1) oFileInfo.FilePath = Left (sFileName,InStrRev (sFileName, \)) oFileInfo.FileExt = Mid (sFileName,InStrRev (sFileName, .)+1) iFindStart = InStr (iFindEnd,sInfo,Content-Type: ,1)+14 iFindEnd = InStr (iFindStart,sInfo,vbCr) oFileInfo.FileType = Mid (sinfo,iFindStart,iFindEnd-iFindStart) oFileInfo.FileStart = iInfoEnd oFileInfo.FileSize = iFormStart -iInfoEnd -2 oFileInfo.FormName = sFormName file.add sFormName,oFileInfo else '如果是表单项目 tStream.Close tStream.Type = 1 tStream.Mode = 3 tStream.Open oUpFileStream.Position = iInfoEnd oUpFileStream.CopyTo tStream,iFormStart-iInfoEnd-2 tStream.Position = 0 tStream.Type = 2 tStream.CharSet = gb2312 sFormValue = tStream.ReadText If Form.Exists (sFormName) Then Form (sFormName) = Form (sFormName) & , & sFormValue else form.Add sFormName,sFormValue End If End If tStream.Close iFormStart = iFormStart+iStart+2 '如果到文件尾了就退出 Loop Until (iFormStart+2) = iFormEnd RequestBinData = Set tStream = Nothing End Sub End Class '---------------------------------------------------------------------------------------------------- '文件属性类 Class FileInfo_Class Dim FormName,FileName,FilePath,FileSize,FileType,FileStart,FileExt '保存文件方法 Public Function SaveToFile (Path) On Error Resume Next Dim oFileStream Set oFileStream = CreateObject (ADODB.Stream) oFileStream.Type = 1 oFileStream.Mode = 3 oFileStream.Open oUpFileStream.Position = FileStart oUpFileStream.CopyTo oFileStream,FileSize oFileStream.SaveToFile Path,2 oFileStream.Close Set oFileStream = Nothing End Function '取得文件数据 Public Function FileData oUpFileStream.Position = FileStart FileData = oUpFileStream.Read (FileSize) End Function End Class ' 检测扩展名的有效性 Sub CheckValidExt(sExt) Dim b, i, aExt b = False sAllowExt = xls aExt = Split(sAllowExt, |) For i = 0 To UBound(aExt) If LCase(aExt(i)) = sExt Then b = True Exit For End If Next If b = False Then response.write(提示：请选择一个有效的文件，支持的格式有（+sAllowExt+）！a href='javascript:history.back(1)'返回/a) Response.End End If End Sub ' 取随机文件名 Function GetRndFileName(sExt) Dim sRnd Randomize sRnd = Int(900 * Rnd) + 100 GetRndFileName = year(now) & month(now) & day(now) & hour(now) & minute(now) & second(now) & sRnd & . & sExt End Function On Error Resume Next Dim oUpload, oFile ' 建立上传对象 Set oUpload = New upfile_class ' 取得上传数据,限制最大上传 oUpload.GetData(1024*1024) Submit = oUpload.Form(Submit) if Submit then If oUpload.Err 0 Then Select Case oUpload.Err Case 1 'Call OutScript(parent.UploadError('请选择有效的上传文件！')) Case 2 Response.Write(你上传的文件总大小超出了最大限制！) Response.End End Select else Set oFile = oUpload.File(file) sFileExt = LCase(oFile.FileExt) sSaveFileName = if sFileExt then Call CheckValidExt(sFileExt) sOriginalFileName = oFile.FileName sSaveFileName = GetRndFileName(sFileExt) oFile.SaveToFile Server.Mappath(sUploadDir & sSaveFileName) end if end if end if % % sub exctoacc(excpath,mdbpath) Dim excConn,Coon Dim excStrConn,strConn Dim excrs,rs Dim excSql Set excconn=Server.CreateObject(ADODB.Connection) Set excrs = Server.CreateObject(ADODB.Recordset) excStrConn=Driver={Microsoft Excel Driver (*.xls)};DriverId=790; DBQ=&Server.MapPath(excpath) excconn.Open excStrConn excSql=select * from [Sheet1$] '查询excel语句 excrs.Open excSql,excconn,2,2 set rs=server.createObject(ADODB.Recordset) Set conn=Server.CreateObject(ADODB.Connection) StrConn=provider=microsoft.jet.oledb.4.0; data source=&Server.MapPath(mdbpath) conn.Open StrConn sql=select * from client rs.open sql,conn,1,3 do while Not excrs.EOF rs.addnew rs(name)=excrs(name) rs(age)=excrs(age) rs(address)=excrs(address) '........这里可以写更多的字段，注意的是ACCESS中的自编号ID不能更新赋值给它！ rs.update excrs.MoveNext Loop rs.close set rs=nothing excrs.close set excrs=nothing excConn.close set excConn=nothing conn.close set conn=nothing response.write数据导入成功！ End sub if sSaveFileName then call exctoacc(sSaveFileName,Database/CLIENT.mdb) %
