下面即是用ASP创建(生成)PDF文件的代码
<%
Option Explicit
Sub CheckXlDriver()
On Error Resume Next
Dim vConnString
Dim oConn, oErr
' try to connect to file NUL:
vConnString = DRIVER={Microsoft Excel Driver (*.xls)};DBQ=NUL:
Set oConn = CreateObject(ADODB.Connection)
oConn.Open vConnString
For Each oErr in oConn.Errors
' when the Excel driver reports Failure creating file,
' then it must be installed and working ;-))
If oErr.NativeError = -5036 Then
Exit Sub
End If
Next
Response.Write Provider or Driver not available. (Re-)Install MDAC.
Response.Write hex(Err.Number) & & Err.Description &
For Each oErr in oConn.Errors
Response.Write hex(oErr.Number) & & oErr.NativeError & & oErr.Description &
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
' from OleDbVbc.inc
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>No such range :</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
Set oRs = Nothing
Else
DataTable = DataTable & <tr><td>File locked by another application or otherwise not accessible. Cannot continue.</td></tr>
End If
DataTable = DataTable & </table>
End Function
' --main--
%>
<html>
<head>
<title>Read Excel</title>
<SCRIPT LANGUAGE=javascript>
<!--
function XlBook_onchange(theForm) {
with (theForm) {
XlSheet.selectedIndex = 0;
XlSheet.disabled = true;
XlNamedRange.selectedIndex = 0;
XlNamedRange.disabled = true;
XlTypedRange.value = A:IV;
}
}
function XlSheet_onchange(theForm) {
with (theForm) {
XlNamedRange.selectedIndex = 0;
XlTypedRange.value = XlSheet.options[XlSheet.selectedIndex].text;
}
}
function XlNamedRange_onchange(theForm) {
with (theForm) {
XlSheet.selectedIndex = 0;
XlTypedRange.value = XlNamedRange.options[XlNamedRange.selectedIndex].text;
}
}
function XlTypedRange_onchange(theForm) {
with (theForm) {
XlSheet.selectedIndex = 0;
XlNamedRange.selectedIndex = 0;
}
}
//-->
</SCRIPT>
</head>
<body>
<%
Dim vXlFile, vXlFilePath
Dim vXlRange, vXlHasHeadings
Dim vDisabled
Dim vConnString
Dim oConn, oConnErr
Const adSchemaTables = 20 ' from adovbs.inc
CheckXlDriver ' make sure it is working
vXlFile = Request(XlBook)
If vXlFile <> Empty Then
vXlRange = Request(XlTypedRange)
If vXlRange = Empty Then
vXlRange = A:IV
Else
vXlRange = Replace(vXlRange, !, $)
End If
vXlHasHeadings = Request(XlHasHeadings)
' establish connection
vXlFilePath = Server.MapPath(vXlFile)
vConnString = DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ= & _ vXlFilePath
Set oConn = GetConnection(vConnString)
Else
vDisabled = disabled
End If
%>
<form name=MyForm method=POST action=<%=Request.ServerVariables(SCRIPT_NAME)%>>
<table border=1 width=100%>
<tr>
<th>Workbook :</th>
<td>
<select name=XlBook LANGUAGE=javascript onchange=return XlBook_onchange(MyForm)>
<%= BookOptions(vXlFile) %>
</select></td>
<td align=center>Worksheet :</td>
<td><select <%=vDisabled%> name=XlSheet LANGUAGE=javascript onchange=return XlSheet_onchange(MyForm)>
<%= NamedRangeOptions(oConn, vXlRange, SYSTEM TABLE) %>
</select></td>
</tr>
<tr>
<th>Range :</th>
<td><input type=text name=XlTypedRange LANGUAGE=javascript onchange=return XlTypedRange_onchange(MyForm)
value =<%= vXlRange %>></td>
<td align=center>Named Range :</td>
<td><select <%=vDisabled%> name=XlNamedRange LANGUAGE=javascript onchange=return XlNamedRange_onchange(MyForm)>
<%= NamedRangeOptions(oConn, vXlRange, TABLE) %>
</select></td>
</tr>
<tr>
<th>
<p> </th>
<td colspan=3>
<input type=checkbox name=XlHasHeadings
<%= IsChecked(vXlHasHeadings) %>
value=True> Show first row as column headings</td>
</tr>
<tr>
<th>
<p> </th>
<td colspan=3>
<a href=<%= vXlFile %>><%= vXlFile %></a>
</td>
</tr>
</table>
<input type=submit value=Submit name=cmdSubmit>
<input type=reset value=Reset name=cmdReset>
</form><hr>
<%
If vXlRange <> Empty Then
Response.Write DataTable(oConn, vXlRange, vXlHasHeadings)
End If
%>
</body>
</html>