asp
- 格式:docx
- 大小:26.42 KB
- 文档页数:17
如何在ASP中利用ADO显示Excel文件内容的函:Function SwitchExcelInfo(xlsFileName)Dim xlsStrDim rsDim i,j,kDim ExcelConnDim ExcelFileDim objExcelAppDim objExcelBookDim bgColorxlsStr = ""ExeclFile = Server.MapPath(xlsFileName)Set objExcelApp = CreateObject("Excel.Application")objExcelApp.QuitSet objExcelApp = CreateObject("Excel.Application")objExcelApp.QuitobjExcelApp.DisplayAlerts = false ’不显示警告objExcelApp.Application.Visible = false ’不显示界面objExcelApp.W orkBooks.Open(ExeclFile)set objExcelBook = objExcelApp.ActiveWorkBookreDim arrSheets(objExcelBook.Sheets.Count)For i=1 to objExcelBook.Sheets.CountarrSheets(i) = objExcelBook.Sheets(i).NameNextobjExcelApp.QuitSet objExeclApp=nothing’#################’Power By ’#################Set ExcelConn = Server.CreateObject("ADODB.Connection")ExcelDriver = "Driver={Microsoft Excel Driver (*.xls)};DBQ=" & ExeclFileExcelConn.Open ExcelDriverSet rs = Server.CreateObject("Adodb.RecordSet")For i = 1 to UBound(arrSheets)Sql = "SELECT * FROM ["& arrSheets(i) &"$] "’’显示各义务表的称号’’xlsStr = xlsStr & "<br>"& arrSheets(i) &"<br>"xlsStr = xlsStr & "<table cellpadding=1 width=""100%"" cellspacing=1 border=1 bordercolor=’#000000’sty le=’bor der-collapse:collapse;border:2px solid #000000’>"rs.Open Sql,ExcelConn,1,1k = 1While Not rs.eofIf k Mod 2 <> 0 Then bgColor = "bgColor=#E0E0E0" Else bgColor = ""xlsStr = xlsStr & "<tr "& bgColor &">"xlsStr = xlsStr & "<td>"& rs(0) &"</td>"For j = 0 to rs.Fields.Count-1xlsStr = xlsStr & "<td>"& rs(j) &"</td>"NextxlsStr = xlsStr & "</tr>"rs.movenextk = k + 1WendxlsStr = xlsStr & "</table><br>"rs.CloseNextExcelConn.CloseSet ExcelConn = NothingSwitchExcelInfo = xlsStrEnd Functionasp操作Excel类:<%'*******************************************************************'运用阐明'Dim a'Set a=new CreateExcel'a.SavePath="x" '保管途径'a.SheetName="义务簿称号" '多个义务表 a.SheetName=array("义务簿称号一","义务簿称号二") 'a.SheetTitle="表称号" '可以为空多个义务表 a.SheetName=array("表称号一","表称号二") 'a.Data =d '二维数组 '多个义务表 array(b,c) b与c为二维数组'Dim rs'Set rs=server.CreateObject("Adodb.RecordSet")'rs.open "Select id, classid, className from [class] ",conn, 1, 1'a.AddDBData rs, "字段名一,字段名二", "义务簿称号", "表称号", true 'true自动获取表字段名'a.AddData c, true , "义务簿称号", "表称号" 'c二维数组 true 第一行能否为标题行'a.AddtData e, "Sheet1" '按模板生成 c=array(array("AA1", "内容"), array("AA2", "内容2")) 'a.Create()'edTime 生成工夫,毫秒数'a.SavePath 保管途径'Set a=nothing'设置COM组件的操作权限。
在命令行键入“DCOMCNFG”,则进入COM组件配置界面,选择MicrosoftExcel 后点击属性按钮,将三个单选项一概选择自定义,编辑中将Everyone参与一切权限'*******************************************************************Class CreateExcelPrivate CreateType_Private savePath_Private readPath_Private AuthorStr Rem 设置作者Private VersionStr Rem 设置版本Private SystemStr Rem 设置零碎称号Private SheetName_ Rem 设置表名Private SheetTitle_ Rem 设置标题Private ExcelData Rem 设置表数据Private ExcelApp Rem Excel.ApplicationPrivate ExcelBookPrivate ExcelSheetsPrivate UsedTime_ Rem 运用的工夫Public TitleFirstLine Rem 首行能否标题Private Sub Class_Initialize()Server.ScriptTimeOut = 99999UsedTime_ = TimerSystemStr = "Lc00_CreateExcelServer"AuthorStr = "Surnfu surnfu@ 31333716"VersionStr = "1.0"if not IsObjInstalled("Excel.Application") thenInErr("效能器未安装Excel.Application控件")end ifset ExcelApp = createObject("Excel.Application")ExcelApp.DisplayAlerts = falseExcelApp.Application.Visible = falseCreateType_ = 1readPath_ = nullEnd SubPrivate Sub Class_Terminate()ExcelApp.QuitIf Isobject(ExcelSheets) Then Set ExcelSheets = NothingIf Isobject(ExcelBook) Then Set ExcelBook = Nothing If Isobject(ExcelApp) Then Set ExcelApp = Nothing End SubPublic Property Let ReadPath(ByVal Val)If Instr(Val, ":\")<>0 ThenreadPath_ = Trim(Val)elsereadPath_=Server.MapPath(Trim(Val))end ifEnd PropertyPublic Property Let SavePath(ByVal Val)If Instr(Val, ":\")<>0 ThensavePath_ = Trim(Val)elsesavePath_=Server.MapPath(Trim(Val)) end ifEnd PropertyPublic Property Let CreateType(ByVal Val) if Val <> 1 and Val <> 2 thenCreateType_ = 1elseCreateType_ = Valend ifEnd PropertyPublic Property Let Data(ByVal Val)if not isArray(Val) thenInErr("表数据设置有误")end ifExcelData = ValEnd PropertyPublic Property Get SavePath()SavePath = savePath_End PropertyPublic Property Get UsedTime()UsedTime = UsedTime_End PropertyPublic Property Let SheetName(ByVal Val)if not isArray(Val) thenif Val = "" thenInErr("表名设置有误")end ifTitleFirstLine = trueelseReDim TitleFirstLine(Ubound(Val)) Dim ik_For ik_ = 0 to Ubound(Val)TitleFirstLine(ik_) = trueNextend ifSheetName_ = ValEnd PropertyPublic Property Let SheetTitle(ByVal Val)if not isArray(Val) thenif Val = "" thenInErr("表标题设置有误")end ifend ifSheetTitle_ = ValEnd PropertyRem 反省数据Private Sub CheckData()if savePath_ = "" then InErr("保管途径不能为空")if not isArray(SheetName_) thenif SheetName_ = "" then InErr("表名不能为空")end ifif CreateType_ = 2 thenif not isArray(ExcelData) thenInErr("数据载入错误,或许未载入")end ifExit Subend ifif isArray(SheetName_) thenif not isArray(SheetTitle_) thenif SheetTitle_ <> "" then InErr("表标题设置有误,与表名不对应")end ifend ifif not IsArray(ExcelData) thenInErr("表数据载入有误")end ifif isArray(SheetName_) thenif GetArrayDim(ExcelData) <> 1 then InErr("表数据载入有误,数据格式错误,维度应该为一")elseif GetArrayDim(ExcelData) <> 2 then InErr("表数据载入有误,数据格式错误,维度应该为二")end ifEnd SubRem 生成ExcelPublic Function Create()Call CheckData()if not isnull(readPath_) thenExcelApp.WorkBooks.Open(readPath_)elseExcelApp.WorkBooks.addend ifset ExcelBook = ExcelApp.ActiveWorkBookset ExcelSheets = ExcelBook.Worksheetsif CreateType_ = 2 thenDim ih_For ih_ = 0 to Ubound(ExcelData)Call SetSheets(ExcelData(ih_), ih_)NextExcelBook.SaveAs savePath_UsedTime_ = FormatNumber((Timer - UsedTime_)*1000, 3) Exit Functionend ifif IsArray(SheetName_) thenDim ik_For ik_ = 0 to Ubound(ExcelData)Call CreateSheets(ExcelData(ik_), ik_)NextelseCall CreateSheets(ExcelData, -1)end ifExcelBook.SaveAs savePath_UsedTime_ = FormatNumber((Timer - UsedTime_)*1000, 3)End FunctionPrivate Sub CreateSheets(ByVal Data_, DataId_)Dim SpreadsheetDim tempSheetTitleDim tempTitleFirstLineif DataId_<>-1 thenif DataId_ > ExcelSheets.Count - 1 thenExcelSheets.Add()set Spreadsheet = ExcelBook.Sheets(1)elseset Spreadsheet = ExcelBook.Sheets(DataId_ + 1)end ifif isArray(SheetTitle_) thentempSheetTitle = SheetTitle_(DataId_)elsetempSheetTitle = ""end iftempTitleFirstLine = TitleFirstLine(DataId_) = SheetName_(DataId_)elseset Spreadsheet = ExcelBook.Sheets(1) = SheetName_tempSheetTitle = SheetTitle_tempTitleFirstLine = TitleFirstLineend ifDim Line_ : Line_ = 1Dim RowNum_ : RowNum_ = Ubound(Data_, 1) + 1Dim LastCols_if tempSheetTitle <> "" then'Spreadsheet.Columns(1).ShrinkToFit=true '设定能否自动顺应表格单元大小(单元格宽不变)LastCols_ = getColName(Ubound(Data_, 2) + 1)with Spreadsheet.Cells(1, 1).value = tempSheetTitle'设置Excel表里的字体.Font.Bold = True '单元格字体加粗.Font.Italic = False '单元格字体倾斜.Font.Size = 20 '设置单元格字号="宋体" '设置单元格字体'.font.ColorIndex=2 '设置单元格文字的颜色,颜色可以查询,2为白色End withwith Spreadsheet.Range("A1:"& LastCols_ &"1").merge '兼并单元格(单元区域)'.Interior.ColorIndex = 1 '设计单元络背风光.HorizontalAlignment = 3 '居中End withLine_ = 2RowNum_ = RowNum_ + 1end ifDim iRow_, iCol_Dim dRow_, dCol_Dim tempLastRange : tempLastRange = getColName(Ubound(Data_, 2)+1) & (RowNum_)Dim BeginRow : BeginRow = 1if tempSheetTitle <> "" then BeginRow = BeginRow + 1if tempTitleFirstLine = true then BeginRow = BeginRow + 1if BeginRow=1 thenwith Spreadsheet.Range("A1:"& tempLastRange).Borders.LineStyle = 1.BorderAround -4119, -4138 '设置外框.NumberFormatLocal = "@" '文本格式.Font.Bold = False.Font.Italic = False.Font.Size = 10.ShrinkToFit=trueend withelsewith Spreadsheet.Range("A1:"& tempLastRange).Borders.LineStyle = 1.BorderAround -4119, -4138.ShrinkToFit=trueend withwith Spreadsheet.Range("A"& BeginRow &":"& tempLastRange).NumberFormatLocal = "@".Font.Bold = False.Font.Italic = False.Font.Size = 10end withend ifif tempTitleFirstLine = true thenBeginRow = 1if tempSheetTitle <> "" then BeginRow = BeginRow + 1with Spreadsheet.Range("A"& BeginRow &":"& getColName(Ubound(Data_, 2)+1) & (BeginRow)).NumberFormatLocal = "@".Font.Bold = True.Font.Italic = False.Font.Size = 12.Interior.ColorIndex = 37.HorizontalAlignment = 3 '居中.font.ColorIndex=2end withend ifFor iRow_ = Line_ To RowNum_For iCol_ = 1 To (Ubound(Data_, 2) + 1)dCol_ = iCol_ - 1if tempSheetTitle <> "" then dRow_ = iRow_ - 2 else dRow_ = iRow_ - 1 If not IsNull(Data_(dRow_, dCol_)) thenwith Spreadsheet.Cells(iRow_, iCol_).Value = Data_(dRow_, dCol_)End withEnd IfNextNextset Spreadsheet = NothingEnd SubRem 测试组件能否已经安装Private Function IsObjInstalled(strClassString)On Error Resume NextIsObjInstalled = FalseErr = 0Dim xTestObjSet xTestObj = Server.CreateObject(strClassString)If 0 = Err Then IsObjInstalled = TrueSet xTestObj = NothingErr = 0End FunctionRem 获得数组维数Private Function GetArrayDim(ByVal arr)GetArrayDim = NullDim i_, tempIf IsArray(arr) ThenFor i_ = 1 To 60On Error Resume Nexttemp = UBound(arr, i_)If Err.Number <> 0 ThenGetArrayDim = i_ - 1Err.ClearExit FunctionEnd IfNextGetArrayDim = i_End IfEnd FunctionPrivate Function GetNumFormatLocal(DataType)Select Case DataTypeCase "Currency":GetNumFormatLocal = "¥#,##0.00_);(¥#,##0.00)"Case "Time":GetNumFormatLocal = "[$-F800]dddd, mmmm dd, yyyy"Case "Char":GetNumFormatLocal = "@"Case "Common":GetNumFormatLocal = "G/通用格式"Case "Number":GetNumFormatLocal = "#,##0.00_"Case else :GetNumFormatLocal = "@"End SelectEnd FunctionPublic Sub AddDBData(ByVal RsFlied, ByVal FliedTitle, ByVal tempSheetName_, ByVal tempSheetTitle_, DBTitle)if RsFlied.Eof then Exit SubDim colNum_ : colNum_ = RsFlied.fields.countDim Rownum_ : Rownum_ = RsFlied.RecordCountDim ArrFliedTitleif DBTitle = true thenFliedTitle = ""Dim ig_For ig_=0 to colNum_ - 1FliedTitle = FliedTitle & RsFlied.fields.item(ig_).nameif ig_ <> colNum_ - 1 then FliedTitle = FliedTitle &","Nextend ifif FliedTitle<>"" thenRownum_ = Rownum_ + 1ArrFliedTitle = Split(FliedTitle, ",")if Ubound(ArrFliedTitle) <> colNum_ - 1 thenInErr("获取数据库表有误,列数不符")end ifend ifDim tempData : ReDim tempData(Rownum_ - 1, colNum_ - 1)Dim ix_, iy_Dim izif FliedTitle<>"" then iz = Rownum_ - 2 else iz = Rownum_ - 1For ix_ = 0 To izFor iy_ = 0 To colNum_ - 1if FliedTitle<>"" thenif ix_=0 thentempData(ix_, iy_) = ArrFliedTitle(iy_)tempData(ix_ + 1, iy_) = RsFlied(iy_)elsetempData(ix_ + 1, iy_) = RsFlied(iy_)end ifelsetempData(ix_, iy_) = RsFlied(iy_)end ifNextRsFlied.MoveNextNextDim tempFirstLineif FliedTitle<>"" then tempFirstLine = true else tempFirstLine = falseCall AddData(tempData, tempFirstLine, tempSheetName_, tempSheetTitle_)End SubPublic Sub AddData(ByVal tempDate_, ByVal tempFirstLine_, ByVal tempSheetName_, ByVal tempSheetTitle_)if not isArray(ExcelData) thenExcelData = tempDate_TitleFirstLine = tempFirstLine_SheetName_ = tempSheetName_SheetTitle_ = tempSheetTitle_elseif GetArrayDim(ExcelData) = 1 thenDim tempArrLen : tempArrLen = Ubound(ExcelData)+1ReDim Preserve ExcelData(tempArrLen)ExcelData(tempArrLen) = tempDate_ReDim Preserve TitleFirstLine(tempArrLen)TitleFirstLine(tempArrLen) = tempFirstLine_ReDim Preserve SheetName_(tempArrLen)SheetName_(tempArrLen) = tempSheetName_ReDim Preserve SheetTitle_(tempArrLen)SheetTitle_(tempArrLen) = tempSheetTitle_elseDim tempOldData : tempOldData = ExcelDataExcelData = Array(tempOldData, tempDate_)TitleFirstLine = Array(TitleFirstLine, tempFirstLine_)SheetName_ = Array(SheetName_, tempSheetName_)SheetTitle_ = Array(SheetTitle_, tempSheetTitle_)end ifend ifEnd SubRem 模板添加数据办法Public Sub AddtData(ByVal tempDate_, ByVal tempSheetName_)CreateType_ = 2if not isArray(ExcelData) thenExcelData = Array(tempDate_)SheetName_ = Array(tempSheetName_)elseDim tempArrLen : tempArrLen = Ubound(ExcelData)+1ReDim Preserve ExcelData(tempArrLen)ExcelData(tempArrLen) = tempDate_ReDim Preserve SheetName_(tempArrLen)SheetName_(tempArrLen) = tempSheetName_End ifEnd SubPrivate Sub SetSheets(ByVal Data_, DataId_)Dim Spreadsheetset Spreadsheet = ExcelBook.Sheets(SheetName_(DataId_))Spreadsheet.ActivateDim ix_For ix_ =0 To Ubound(Data_)if not isArray(Data_(ix_)) then InErr("表数据载入有误,数据格式错误") if Ubound(Data_(ix_)) <> 1 then InErr("表数据载入有误,数据格式错误") Spreadsheet.Range(Data_(ix_)(0)).value = Data_(ix_)(1)Nextset Spreadsheet = NothingEnd SubPublic Function GetTime(msec_)Dim ReTime_ : ReTime_=""if msec_ < 1000 thenReTime_ = msec_ &"MS"elseDim second_second_ = (msec_ \ 1000)if (msec_ mod 1000)<>0 thenmsec_ = (msec_ mod 1000) &"毫秒"elsemsec_ = ""end ifDim n_, aryTime(2), aryTimeunit(2)aryTimeunit(0) = "秒"aryTimeunit(1) = "分"aryTimeunit(2) = "小时"n_ = 0Dim tempSecond_ : tempSecond_ = second_While(tempSecond_ / 60 >= 1)tempSecond_ = Fix(tempSecond_ / 60 * 100) / 100n_ = n_ + 1WEndDim m_For m_ = n_ To 0 Step -1aryTime(m_) = second_ \ (60 ^ m_)second_ = second_ mod (60 ^ m_)ReTime_ = ReTime_ & aryTime(m_) & aryTimeunit(m_)Nextif msec_<>"" then ReTime_ = ReTime_ & msec_end ifGetTime = ReTime_end FunctionRem 获得列名Private Function getColName(ByVal ColNum)Dim Arrlitter : Arrlitter=split("A B C D E F G H I J K L M N O P Q R S T U V W X Y Z", " ")Dim ReValue_if ColNum <= Ubound(Arrlitter) + 1 thenReValue_ = Arrlitter(ColNum - 1)elseReValue_ = Arrlitter(((ColNum-1) \ 26)) & Arrlitter(((ColNum-1) mod 26))end ifgetColName = ReValue_End FunctionRem 设置错误Private Sub InErr(ErrInfo)Err.Raise vbObjectError + 1, SystemStr &"(Version "& VersionStr &")", ErrInfo End SubEnd ClassDim b(4,6)Dim c(50,20)Dim i, jFor i=0 to 4For j=0 to 6b(i,j) =i&"-"&jNextNextFor i=0 to 50For j=0 to 20c(i,j) = i&"-"&j &"我的"NextNextDim e(20)For i=0 to 20e(i)= array("A"&(i+1), i+1)Next'运用示例需求xx.xls模板支持'Set a=new CreateExcel'a.ReadPath = "xx.xls"'a.SavePath="xx-1.xls"'a.AddtData e, "Sheet1"'a.Create()'response.Write("生成"& a.SavePath &" 运用了 "& a.GetTime(edTime) &"<br>")'Set a=nothing'运用示例一Set a=new CreateExcela.SavePath="x.xls"a.AddData b, true , "测试c", "测试c"a.TitleFirstLine = false '首行能否为标题行a.Create()response.Write("生成"& a.SavePath &" 运用了 "& a.GetTime(edTime) &"<br>")Set a=nothing'运用示例二Set a=new CreateExcela.SavePath="y.xls"a.SheetName="义务簿称号" '多个义务表 a.SheetName=array("义务簿称号一","义务簿称号二")a.SheetTitle="表称号" '可以为空多个义务表 a.SheetName=array("表称号一","表称号二")a.Data =b '二维数组 '多个义务表 array(b,c) b与c为二维数组a.Create()response.Write("生成"& a.SavePath &" 运用了 "& a.GetTime(edTime) &"<br>")Set a=nothing'运用示例三生成两个表Set a=new CreateExcela.SavePath="z.xls"a.SheetName=array("义务簿称号一","义务簿称号二")a.SheetTitle=array("表称号一","表称号二")a.Data =array(b, c) 'b与c为二维数组a.TitleFirstLine = array(false, true) '首行能否为标题行a.Create()response.Write("生成"& a.SavePath &" 运用了 "& a.GetTime(edTime) &"<br>")Set a=nothing'运用示例四需求数据库支持'Dim rs'Set rs=server.CreateObject("Adodb.RecordSet")'rs.open "Select id, classid, className from [class] ",conn, 1, 1'Set a=new CreateExcel'a.SavePath="a"'a.AddDBData rs, "序号,类别序号,类别称号", "义务簿称号", "类别表", false'a.Create()'response.Write("生成"& a.SavePath &" 运用了 "& a.GetTime(edTime) &"<br>")'Set a=nothing'rs.close'Set rs=nothing%>通过asp下载文件(asp应用篇)如何通过ASP下载文件?代码如下:Sometimes you want a user to download a binary file instead of opening it inside the browser window.There are several different way s to accomplish this.Generically:<%FileName = "Document.Doc"Response.ContentType = "application/octet-stream"Response.AddHeader "content-disposition", "attachment; filename =" & filenameSet Stream = Server.CreateObject("ADODB.Stream")Stream.OpenStream.LoadFromFile Server.MapPath(Filename)Conents = Stream.ReadT extResponse.BinaryWrite ContentsStream.CloseSet Stream = Nothing%>If you know the file type that you would like the user to download, try:<%Filename = "document.doc"Response.ContentType = "application/vnd.ms-word"Response.AddHeader "content-disposition", "attachment; filename=" & filename%>Other Content Types:vnd.ms-excel - For Excelvnd.ms-powerpoint - For PowerPointvnd.ms-project - For Microsoft Projectpdf - For Adobe Acrobat Documentsrtf - For Rick T ext Documentsvnd.lotus-wordpro - For WordProvnd.lotus-1-2-3 - For Lotus 1-2-3vnd.v isio - For Visiojpeg - for JPG Image Filegif - for GIF Image Filepng - for PNG Image FileASP数据库怎样两个条件查询要怎么写才能查询同时满足两个条件?匿名回答:7 人气:7 解决时间:2009-12-21 12:02精华知识好评率:62%这要看你是模糊查询还是精确查询模糊查询的方法:select * from news where 字段1 like '%关键字%' and 字段2 like '%关键字%'精确查询的方法:select * from news where 字段1=xxx and 字段2=xxxx我用了VBScript中的Dateadd()函数,将其返回值和oracle的一个Date型的字段time进行比较,这两种日期格式不一样,如何在sql语句中进行比较?select * from table where dat> to_date( ' " & defdate & " ','yyyy-mm-dd hh24:mi:ss ')。