<%
Rem 初始化ExcelApplication的工作环境
Dim ExcelApp,eBook,eSheet
Set ExcelApp = CreateObject(”Excel.Application”) ‘建立Excel对象
ExcelApp.DisplayAlerts=false ‘不显示警告
ExcelApp.Application.Visible=false ‘不显示界面
Rem 初始化Excel数据
‘ExcelApp.Workbooks.Open(Server.MapPath(”zzz.xls”)) ‘打开Excel工作本,可替换下面一行
Set eBook=ExcelApp.Workbooks.Add ‘新建Excel工作本
Set eBook=ExcelApp.Workbooks(1) ‘引用第一个工作本
set eSheet = eBook.Worksheets(1) ‘引用第一个工作表
Rem 数据导入
Dim i,img
i = 1
For i=1 To 5
eSheet.Cells(i,1).Value=”字段一”&i
eSheet.Cells(i,2).Value=”字段二”&i
eSheet.Cells(i,3).Value=”字段三”&i
eSheet.Cells(i,4).Select ‘选择第i行第4个单元单元格
Set img=eSheet.Pictures.Insert(Server.MapPath(”people.jpg”)) ‘在上述位置插入图片,并得到图片的引用
img.Top=img.Top+2 ‘调整图片位置,下同, 否则它会压住表格边线
img.Left=img.Left+2 ‘单位是磅
eSheet.Rows(i).RowHeight=img.Height+4 ‘调整当前行的高度,让它自动与图片高度相同
Next
Rem 保存上述所做的工作
‘eBook.Save ‘如果是打开已经存在的Excel文件,则可选用这行来代替下面一行
eBook.SaveAs Server.MapPath(”zzz.xls”)
Set eSheet=Nothing
Set eBook=Nothing
‘ExcelApp.Quit ‘一定要退出, 否则Excel的进程留在操作系统中.
set ExcelApp = Nothing
%>

 

<%
Dim conn,rs,sql
Sub DBOpen()
Dim db : db=Server.MapPath(”zzz.xls”)
Set conn=Server.CreateObject(”Adodb.Connection”)
On Error Resume Next
conn.Open “Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=”"Excel 8.0;HDR=YES”";Data Source=” & db
Rem HDR 默认为YES,表示第一行作为字段名, 否则视它为内容
Rem 对于Excel2007,而应为: “Provider=Microsoft.ACE.OLEDB.12.0; Extended Properties=Excel 12.0;Data Source=xxx.xlsx;”
If Err.Number<>0 then
Err.Clear
Response.Write(”

The Database link is ERROR

”)
Response.End()
End If
On Error GoTo 0
End Sub
Sub DBClose()
If IsNotBlank(conn) Then
conn.Close()
Set conn=Nothing
End If
End Sub
Function IsNotBlank(ByRef TempVar)
IsBlank = True
Select Case VarType(TempVar)
Case 0,1 ‘Empty & Null
IsBlank = False
Case 9 ‘Object
If TypeName(TempVar) = “Nothing” Or TypeName(TempVar) = “Empty” Then
IsBlank = False
End If
End Select
End Function
Call DBOpen()
sql=”SELECT * FROM [Sheet1$]” ‘注意表名的写法, 需要在工作表名的后面加符号$
Set rs=conn.Execute(sql)
While Not rs.Eof
Response.Write(rs(0)&”, “)
Response.Write(rs(1)&”, “)
Response.Write(rs(2)&”
”&VbCrLf)
rs.Movenext
Wend
rs.Close : Set rs=Nothing
Call DBClose()
%>