如何创建一个PDF文件?
如何创建一个PDF文件?
发布时间:2016-12-29 来源:查字典编辑
摘要:0ThenForEachoConnErrinoConn.ErrorsIfoConnErr.Number=DB_E_ERRORSINCOMMA...

<%

Option Explicit

Sub CheckXlDriver()

On Error Resume Next

Dim vConnString

Dim oConn, oErr

vConnString = "DRIVER={Microsoft Excel Driver (*.xls)};DBQ=NUL:"

' 连接NUL.

Set oConn = CreateObject("ADODB.Connection")

oConn.Open vConnString

For Each oErr in oConn.Errors

' 如果Excel程序报告"文件创建失败",别担心,这表示它正在正常运行呢.

If oErr.NativeError = -5036 Then

Exit Sub

End If

Next

Response.Write " MDAC 供应商或驱动程序不可用,请检查或重新安装!<br><br>"

Response.Write hex(Err.Number) & " " & Err.Description & "<br>"

For Each oErr in oConn.Errors

Response.Write hex(oErr.Number) & " " & oErr.NativeError & " " &

oErr.Description & "<br>"

Next

Response.End

End Sub

Function GetConnection(vConnString)

On Error Resume Next

Set GetConnection = Server.CreateObject("ADODB.Connection")

GetConnection.Open vConnString

If Err.Number <> 0 Then

Set GetConnection = Nothing

End If

End Function

Function OptionTag(vChoice,vTrue)

Dim vSelected

If vTrue Then

vSelected = "selected"

End If

OptionTag = "<option " & vSelected & ">" & _

Server.htmlEncode(vChoice) & "</option>" & vbCrLf

End Function

Function IsChecked(vTrue)

If vTrue Then

IsChecked = "checked"

End If

End Function

Function BookOptions(vXlFile)

Dim vServerFolder

Dim oFs, oFolder, oFile

Dim vSelected

vServerFolder = Server.MapPath(".")

Set oFs = Server.CreateObject("Scripting.FileSystemObject")

Set oFolder = oFs.GetFolder(vServerFolder)

For Each oFile in oFolder.Files

If oFile.Type = "Microsoft Excel Worksheet" Then

vSelected = (oFile.Name = vXlFile)

BookOptions = BookOptions & _

OptionTag(oFile.Name, vSelected)

End If

Next

Set oFolder = Nothing

Set oFs = Nothing

End Function

Function NamedRangeOptions(oConn, vXlRange, vTableType)

Dim oSchemaRs

Dim vSelected

NamedRangeOptions = OptionTag(Empty, Empty)

If TypeName(oConn) = "Connection" Then

Set oSchemaRs = oConn.OpenSchema(adSchemaTables)

Do While Not oSchemaRs.EOF

If oSchemaRs("TABLE_TYPE") = vTableType Then

vSelected = (oSchemaRs("TABLE_NAME") = vXlRange)

NamedRangeOptions = NamedRangeOptions & _

OptionTag(oSchemaRs("TABLE_NAME"), vSelected)

End If

oSchemaRs.MoveNext

Loop

End If

End Function

Function DataTable(oConn, vXlRange, vXlHasheadings)

On Error Resume Next

Const DB_E_ERRORSINCOMMAND = &H80040E14

Dim oRs, oField

Dim vThTag, vThEndTag

If vXlHasheadings Then

vThTag = "<th>"

vThEndTag = "</th>"

Else

vThTag = "<td>"

vThEndTag = "</td>"

End If

DataTable = "<table border=1>"

If TypeName(oConn) = "Connection" Then

Set oRs = oConn.Execute("[" & vXlRange & "]")

If oConn.Errors.Count > 0 Then

For Each oConnErr in oConn.Errors

If oConnErr.Number = DB_E_ERRORSINCOMMAND Then

DataTable = DataTable & _

"<tr><td>该范围不存在:</td><th>" & vXlRange & "</th></tr>"

Else

DataTable = DataTable & _

"<tr><td>" & oConnErr.Description & "</td></tr>"

End If

Next

Else

DataTable = DataTable & "<tr>"

For Each oField in oRs.Fields

DataTable = DataTable & vThTag & oField.Name & vThEndTag

Next

DataTable = DataTable & "</tr>"

Do While Not oRs.Eof

DataTable = DataTable & "<tr>"

For Each oField in oRs.Fields

DataTable = DataTable & "<td>" & oField.Value & "</td>"

Next

DataTable = DataTable & "</tr>"

oRs.MoveNext

Loop

End If

[1][2]下一页

推荐文章
猜你喜欢
附近的人在看
推荐阅读
拓展阅读
相关阅读
网友关注
最新编程10000问学习
热门编程10000问学习
编程开发子分类