How to Create a PDF file?

 

<%
Option Explicit
Sub CheckXlDriver ()
On Error Resume Next

Dim vConnString
Dim oConn, oErr

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

Set oConn = CreateObject ("ADODB. Connection ")
OConn. Open vConnString

For Each oErr in oConn. Errors
'IfExcelProgram Report"File Creation failed",Don't worry,This indicates that it is running normally..

If oErr. NativeError =-5036 Then
Exit Sub
End If
Next

Response. Write "MDACSupplier or driver unavailable,Please check or reinstall! <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.html Encode (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>The specified range does not exist.: </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] Next page