I have the following script in a classic asp page:
<%
Response.Write "<script language=""vbscript"">" & vbcrlf
'----------------------------------
Response.Write "sub window_onload" & vbcrlf
'Response.Write "On Error Resume Next" & vbcrlf
Response.Write " dim t1 " & vbcrlf
Response.Write " set xfile = AXFFileDownload.XFRequest " & vbcrlf
Response.Write " AXFFileDownload.AddFile ""c:\contalfinger\tester.mdb"", ""http://" & Request.servervariables("LOCAL_ADDR") & application("portinternet") & "/transfert_fichiers/FZ" & kteur & ".mdb" & chr(34) & vbcrlf
Response.Write " If Err.number <> 0 Then " & vbcrlf
Response.Write " msgbox(""You may not have SA-XFile installed."") " & vbcrlf
Response.Write " End IF " & vbcrlf
'Response.Write " call contalMSN.faireDirectory(""c:\contalfinger"") " & vbcrlf
Response.Write " t1=contalMSN.wait(2) " & vbcrlf
Response.write " AXFFileDownload.Start" & vbcrlf
'Response.Write " call contalMSN.faireCMD(""c:\tmp\fichier2.eml"") " & vbcrlf
'Response.Write " window.close() " & vbcrlf
Response.Write " window.location.href=""loginfinger.asp" & chr(34) & vbcrlf
Response.Write "end sub" & vbcrlf
Response.Write "</script>" & vbcrlf
%>
The problem is that the mdb file on the server has 336KB but when it is downloaded to the client computer it's reduce to 2KB and can't be open due to following error message: Unrecorignised database format.
This script was working before we change server.
Any help will be reallly appreciated.
Thank you
Ok I found it. I had to modify the file found in the below path:
C:\Windows\System32\inetsrv\config\applicationhost.config
<add fileExtension=".mdb" allowed="false" /> for <add fileExtension=".mdb" allowed="true" />
Related
I'm trying to register a new user in an SQL Server DB, from Classic ASP
I appreciate the Classic ASP is antiquated, but I familiar with it and it does the job I need to to (generally).
Here's the code...
<%
Set rs = CreateObject("ADODB.Recordset")
Set con = Server.CreateObject("ADODB.Connection")
con.ConnectionString="Provider=SQLOLEDB;" & _
"Server=Server\SQLEXPRESS;" & _
"Uid=IUSR;" & _
"Pwd=Pwd;" & _
"Database=DB"
con.Open
username="username"
password="password"
tsql="CREATE TABLE #newUserTable(UserID int); " & vbCrLf & _
"DECLARE #responseMessage NVARCHAR(50); " & vbCrLf & _
"DECLARE #userID INT; " & vbCrLf & _
"IF EXISTS (SELECT TOP 1 UserID FROM [dbo].[UserLogins] WHERE LoginName='" & username & "') " & vbCrLf & _
"BEGIN " & vbCrLf & _
"SET #responseMessage='User already exists' " & vbCrLf & _
"END " & vbCrLf & _
"ELSE " & vbCrLf & _
"BEGIN " & vbCrLf & _
"DECLARE #salt UNIQUEIDENTIFIER=NEWID(); " & vbCrLf & _
"BEGIN TRY " & vbCrLf & _
"INSERT INTO dbo.UserLogins (LoginName,PasswordHash,Salt) " & vbCrLf & _
"OUTPUT INSERTED.UserID INTO #newUserTable " & vbCrLf & _
"VALUES ('" & username & "',HASHBYTES('SHA2_512', '" & password & "'+CAST(#salt AS NVARCHAR(36))),#salt); " & vbCrLf & _
"SET #responseMessage=" & vbCrLf & _
"CAST((SELECT userID FROM #newUserTable) AS NVARCHAR(50)); " & vbCrLf & _
"END TRY " & vbCrLf & _
"BEGIN CATCH " & vbCrLf & _
"SET #responseMessage=ERROR_MESSAGE() " & vbCrLf & _
"END CATCH " & vbCrLf & _
"END " & vbCrLf & _
"SELECT #responseMessage AS N'responseMessage'; " & vbCrLf & _
"DROP TABLE #newUserTable"
'response.write tsql & "<hr />"
rs.open tsql, con
response.write rs("responseMessage")
rs.close
%>
When I attempt to add an existing user, I get the expected User already exists response, but when I attempt to add a new user, I get Item cannot be found in the collection corresponding to the requested name or ordinal which suggests that rresponseMessage doesn't exist. If I output the tsql to the browser (replacing vbCrLf with "") and run it in SQL Server, I get the userID returned as responseMessage as I would expect.
Can anyone suggest why this might be, and how I can correct it?
Change your last command to SELECT #responseMessage AS N'responseMessage' (instead of the Drop).
You can also try using "SET NOCOUNT ON" to avoid count messages messing your results.
Also, you don't need to add vbCrLf to TSQL
Your code should look like this:
tsql="SET NOCOUNT ON; " & _
"CREATE TABLE #newUserTable(UserID int); " & _
"DECLARE #responseMessage NVARCHAR(50); " & _
"DECLARE #userID INT; " & _
"IF EXISTS (SELECT TOP 1 UserID FROM [dbo].[UserLogins] WHERE LoginName='" & username & "') " & _
"BEGIN " & _
"SET #responseMessage='User already exists' " & _
"END " & _
"ELSE " & _
"BEGIN " & _
"DECLARE #salt UNIQUEIDENTIFIER=NEWID(); " & _
"BEGIN TRY " & _
"INSERT INTO dbo.UserLogins (LoginName,PasswordHash,Salt) " & _
"OUTPUT INSERTED.UserID INTO #newUserTable " & _
"VALUES ('" & username & "',HASHBYTES('SHA2_512', '" & password & "'+CAST(#salt AS NVARCHAR(36))),#salt); " & _
"SET #responseMessage=" & _
"CAST((SELECT userID FROM #newUserTable) AS NVARCHAR(50)); " & _
"END TRY " & _
"BEGIN CATCH " & _
"SET #responseMessage=ERROR_MESSAGE() " & _
"END CATCH " & _
"END " & _
"DROP TABLE #newUserTable" & _
"SELECT #responseMessage AS N'responseMessage'; "
I have a piece of code which will show a list of service areas and, then, when you select a service area it will bring back a list of departments in the second dropdown box. I have the following code:
<%# Language="VBScript"%>
<% response.Buffer = TRUE
'Defines the variables and objects
dim ADUser, RecordList, intOne, intTwo, intThree, companies, service_area, department, arrComp
'Assigns the objComp and objDept variables to Scripting Dictionary objects
%>
<!--#include file="includes/functions.asp"-->
<!--#include file="includes/display.asp"-->
<!--#include file="includes/results.asp"-->
<!--#include file="includes/timer.asp"-->
<h1>Organisational Structure</h1>
<div class="commandspace">
<p class="infotext">The org structure can be viewed with or without staff, indented or left justified.</p>
</div>
<%
ADUser = "LDAP://RBCTHDC1/OU=Staff,OU=Users,DC=example,DC=internal"
' Make AD connection and run query
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.provider ="ADsDSOObject"
objCon.Properties("User ID") = "DOMAIN\username"
objCon.Properties("Password") = "Password"
objCon.Properties("Encrypt Password") = TRUE
objCon.open "Active Directory Provider"
Set objCom = CreateObject("ADODB.Command")
Set objCom.ActiveConnection = objCon
objCom.CommandText ="select company FROM '"& ADUser &"' where company ='*'"
Set objRS = objCom.Execute 'Creates an object and runs the LDAP query
companies = objRS.GetRows()
set arrComp = Server.CreateObject("Scripting.Dictionary")
for intOne = 0 to UBound(companies,2)
if not arrComp.exists(companies(0, intOne)) then
arrComp.add companies(0, intOne), companies(0, intOne)
end if
next
response.write "<form action='index.asp?View=Structure' method='POST'>"
response.write "<select id='service_area' name='service_area' onChange='showTeams(this.value)'>"
response.write "<option>Please Select</option>"
for intTwo = 0 to arrComp.Count
response.write "<option value='"& Server.URLEncode(arrComp.Item(intTwo)) &"'>" & arrComp.Item(intTwo) & "</option>" & VBCrlF
next
response.write "</select>" & VBCrlF
response.write "<span class='structure-spacing'></span>" & VBCrlF
response.write "<select id='department' name='department'></select>" & VBCrlF
response.write "<span class='structure-spacing'></span>" & VBCrlF
response.write "<input type='submit' name='submit' id='submit'>" & VBCrlF
response.write "</form>" & VBCrlF
if request.form("submit")="Submit" then
service_area = request.form("service_area")
department = request.form("department")
if service_area = "Please Select" then
response.write "<p>Service area cannot be left empty</p>"
end if
if IsEmpty(department) then
response.write "<p>Department cannot be left empty</p>"
end if
objCom.CommandText ="select company, department, title, cn FROM '"& ADUser &"' where department = '" & department & "' ORDER BY department"
else
objCom.CommandText ="select company, department, title, cn FROM '"& ADUser &"' where company ='*' ORDER BY department"
end if
Set objRS = objCom.Execute 'Creates an object and runs the LDAP query
RecordList = objRS.GetRows()
response.write "<table>" & VBCrlF
response.write "<thead>" & VBCrlF
response.write "<tr>" & VBCrlF
response.write "<th>Service Area</th>" & VBCrlF
response.write "<th>Department</th>" & VBCrlF
response.write "<th>Job Title</th>" & VBCrlF
response.write "<th>Name</th>" & VBCrlF
response.write "</tr>" & VBCrlF
response.write "</thead>" & VBCrlF
response.write "<tbody>" & VBCrlF
for intThree = 0 to UBound(RecordList,2)
response.write "<tr>" & VBCrlF
response.write "<td>" & RecordList(3, intThree) & "</td>" & VBCrlF
response.write "<td>" & RecordList(2, intThree) & "</td>" & VBCrlF
response.write "<td>" & RecordList(1, intThree) & "</td>" & VBCrlF
response.write "<td>" & RecordList(0, intThree) & "</td>" & VBCrlF
response.write "</tr>" & VBCrlF
next
response.write "</tbody>" & VBCrlF
response.write "</table>" & VBCrlF
objRS.Close
objCon.Close
Set objCon = Nothing
Set objCom = Nothing
%>
I can't find a way of removing duplicate entries. Using a Scripting Dictionary, I am getting an empty drop down box. Instead of returning a list of service area, it doesn't return anything - just an empty option value
I need to check http connection with vbscript
I thought to ping to the host and to see if the host responds
I need to test the connection to a specific port and why not also with a url
do you have a solution?
You can try like this :
Option Explicit
Dim Title,strHost
Title = "Check Connection"
strHost = "www.stackoverflow.com"
if Ping(strHost) = True then
MsgBox "Host " & DblQuote(strHost) & " contacted",vbInformation,Title
Else
MsgBox "Host " & DblQuote(strHost) & " could not be contacted",vbCritical,Title
end if
'***********************************************************************************
Function Ping(strHost)
dim objPing, objRetStatus
set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
("select * from Win32_PingStatus where address = '" & strHost & "'")
for each objRetStatus in objPing
if IsNull(objRetStatus.StatusCode) or objRetStatus.StatusCode <> 0 then
Ping = False
'WScript.Echo "Status code is " & objRetStatus.StatusCode
else
Ping = True
'Wscript.Echo "Bytes = " & vbTab & objRetStatus.BufferSize
'Wscript.Echo "Time (ms) = " & vbTab & objRetStatus.ResponseTime
'Wscript.Echo "TTL (s) = " & vbTab & objRetStatus.ResponseTimeToLive
end if
next
End Function
'***********************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'************************************************************************************
I'm inspired by this ==> How to check Network port access and display useful message?
And i created a vbscript wrapped with the powershell script
Just give a try :
Option Explicit
Dim Title,Ws,ByPassPSFile,strHost,Example,PSFile,MyCmd,Result,MyArray,LogFile,fso
Title = "Check Network port access "
Set Ws = CreateObject("wscript.Shell")
Set fso = Createobject("Scripting.FileSystemObject")
LogFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "txt"
PSFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
ByPassPSFile = "cmd /c PowerShell.exe -ExecutionPolicy bypass -noprofile -file "
Example = "www.google.com:80"
strHost = InputBox("Enter the host name with its port to check it " & vbcr & "Example : " & vbcr & Dblquote(Example) & "",Title,Example)
If strHost = "" or IsEmpty(strHost) Then Wscript.Quit()
MyArray = Split(strHost,":")
MyCmd = "function Test-Port($hostname,$port)"& VbCrLF &_
"{"& VbCrLF &_
"# This works no matter in which form we get $host - hostname or ip address" & VbCrLF &_
"try {"& VbCrLF &_
"$ip = [System.Net.Dns]::GetHostAddresses($hostname) |"& VbCrLF &_
"select-object IPAddressToString -expandproperty IPAddressToString"& VbCrLF &_
"if($ip.GetType().Name -eq ""Object[]"")"& VbCrLF &_
"{"& VbCrLF &_
"#If we have several ip's for that address, let's take first one"& VbCrLF &_
"$ip = $ip[0]"& VbCrLF &_
"}"& VbCrLF &_
"} catch {"& VbCrLF &_
"return ""Possibly $hostname is wrong hostname or IP"""& VbCrLF &_
"}"& VbCrLF &_
"$t = New-Object Net.Sockets.TcpClient"& VbCrLF &_
"# We use Try\Catch to remove exception info from console if we can't connect"& VbCrLF &_
"try"& VbCrLF &_
"{"& VbCrLF &_
"$t.Connect($ip,$port)"& VbCrLF &_
"} catch {}"& VbCrLF &_
"if($t.Connected)"& VbCrLF &_
"{"& VbCrLF &_
"$t.Close()"& VbCrLF &_
"$msg = ""Port $port is operational on $hostname with ip adress $ip"""& VbCrLF &_
"}"& VbCrLF &_
"else"& VbCrLF &_
"{"& VbCrLF &_
"$msg = ""Port $port on $hostname with ip $ip is closed, """& VbCrLF &_
"$msg += ""You may need to contact your IT team to open it."""& VbCrLF &_
"}"& VbCrLF &_
"return $msg"& VbCrLF &_
"}"& VbCrLF &_
"Test-Port "& MyArray(0) & " "& MyArray(1) & " > "& LogFile &""& VbCrLF
Call WriteMyPSFile(MyCmd)
Result = Ws.run(ByPassPSFile & PSFile,0,True)
ws.run LogFile
'**********************************************************************************************
Sub WriteMyPSFile(strText)
Dim fs,ts,PSFile
Const ForWriting = 2
PSFile = Left(Wscript.ScriptFullName, InstrRev(Wscript.ScriptFullName, ".")) & "ps1"
Set fs = CreateObject("Scripting.FileSystemObject")
Set ts = fs.OpenTextFile(PSFile,ForWriting,True)
ts.WriteLine strText
ts.Close
End Sub
'**********************************************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'**********************************************************************************************
I'm trying to submit my EnquiryForm using .Asp but I keep getting a server error...
Would like to send the captured form details to my email address and also confirm the details with the customer.
Any thoughts why its not working....
Updated Code:
<%#LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<title>Untitled Document</title>
</head>
<body>
<%
'send by connecting to port 25 of the SMTP server'
Dim iMsg
Dim iConf
Dim Flds
Dim strBody
Dim strSmartHost
Const cdoSendUsingPort = 2
StrSmartHost = "smtp.glimmer-nights.co.uk"
set iMsg = CreateObject("CDO.Message")
set iConf = CreateObject("CDO.Configuration")
set Flds = iConf.Fields
'Set the CDOSYS configuration fields to use port 25 on the SMTP server'
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmartHost
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
.Update
End With
'Build Message body'
strBody = "Fullname: " & Request.form("firstname") & Request.form("Surname") & vbcrlf
strBody = strBody & "Address: " & Request.form("Address") & vbcrlf
strBody = strBody & "Postcode: " & Request.form("postcode") & vbcrlf
strBody = strBody & "Contact No: " & Request.form("tel") & vbcrlf
strBody = strBody & "Email: " & Request.form("email") & vbcrlf
strBody = strBody & "How did you hear about us: " & Request.form("where") & vbcrlf
strBody = strBody & "Function Date: " & Request.form("fday") & Request.form("fmonth") & Request.form("fyear") & vbcrlf
strBody = strBody & "Venue Name: " & Request.form("vname") & vbcrlf
strBody = strBody & "Venue Address: " & Request.form("vaddress") & vbcrlf
strBody = strBody & "Venue Postcode: " & Request.form("vpostcode") & vbcrlf
strBody = strBody & "Function Type: " & Request.form("ftype") & vbcrlf
strBody = strBody & "No. Attending: " & Request.form("noattend") & vbcrlf
strBody = strBody & "Arrive At: " & Request.form("arrive") & vbcrlf
strBody = strBody & "Guest Arrival: " & Request.form("garrival") & vbcrlf
strBody = strBody & "Function End: " & Request.form("fend") & vbcrlf
strBody = strBody & "Additional Information: " & Request.form("additionalInfoTextarea")
'Apply the settings to the message'
With iMsg
Set .Configuration = iConf
.To = "info#glimmer-nights.co.uk"
.From = "info#glimmer-nights.co.uk"
.Subject = "Online Enquiry"
.TextBody = strBody
.Send
End With
Response.Write("<h1>Booking Enquiry Sent!</h1><p>Thank you for submitting your online booking enquiry for DJ's in Telford or Dj's in Shropshire. We will contact you shortly.<p>")
'SEND EMAIL TO CUSTOMER'
'Build Message body'
strBody = "Hi " & Request.form("firstname") & " " & Request.form("surname") & "," & vbcrlf & vbcrlf
strBody = strBody & "We have your contact details as follows: " & vbcrlf & vbcrlf
strBody = strBody & "Fullname: " & Request.form("firstname") & Request.form("Surname") & vbcrlf
strBody = strBody & "Contact No: " & Request.form("tel") & vbcrlf
strBody = strBody & "Email: " & Request.form("email") & vbcrlf
strBody = strBody & "Address: " & Request.form("Address") & vbcrlf
strBody = strBody & "Postcode: " & Request.form("postcode") & vbcrlf
strBody = strBody & "Your function details are as follows: " & vbcrlf & vbcrlf
strBody = strBody & "Function Date: " & Request.form("fday") & Request.form("fmonth") & Request.form("fyear") & vbcrlf
strBody = strBody & "Venue Name: " & Request.form("vname") & vbcrlf
strBody = strBody & "Venue Address: " & Request.form("vaddress") & vbcrlf
strBody = strBody & "Venue Postcode: " & Request.form("vpostcode") & vbcrlf
strBody = strBody & "Function Type: " & Request.form("ftype") & vbcrlf
strBody = strBody & "No. Attending: " & Request.form("noattend") & vbcrlf
strBody = strBody & "Guest Arrival: " & Request.form("garrival") & vbcrlf
strBody = strBody & "Function End: " & Request.form("fend") & vbcrlf
strBody = strBody & "Additional Information: " & Request.form("additionalInfoTextarea") & vbcrlf
strBody = strBody & "Your quotation will be based on the information provided above." & vbcrlf & vbcrlf
strBody = strBody & "Thank you for your online booking enquiry. We will be in contact with you shortly to confirm availability & prices." & vbcrlf & vbcrlf
strBody = strBody & "We look forward to speaking to you soon." & vbcrlf & vbcrlf
strBody = strBody & "DJ Glimmer" & vbcrlf
strBody = strBody & "Glimmer Nights Entertainment" & vbcrlf
strBody = strBody & "T: 01952 247207" & vbcrlf
strBody = strBody & "M: 07772 471449" & vbcrlf & vbcrlf
'Apply the settings to the message'
With iMsg
Set .Configuration = iConf
.To = Request.form("email")
.From = "info#glimmer-nights.co.uk"
.Subject = "Your Entertainment Booking Enquiry"
.TextBody = strBody
.Send
End With
Then
'Enquiry Sent - redirect to Home page'
Response.Redirect("http://www.glimmer-nights.co.uk/index.html")
End
'Cleanup of variables'
Set iMsg = Nothing
Set iConf = Nothing
Set Flds = Nothing
%>
</body>
</html>
You have syntax error. There is this block of code:
Then
'Enquiry Sent - redirect to Home page'
Response.Redirect("http://www.glimmer-nights.co.uk/index.html")
End
It's wrong, probably left my mistake by the programmer who wrote the code for you. It should be just:
'Enquiry Sent - redirect to Home page'
Response.Redirect("http://www.glimmer-nights.co.uk/index.html")
If still no luck please post full error message and what line is causing it.
I'm using ASP.Net to output HTML/XML data so that it can be opened by MS Excel. The idea of course is to be able to send any tabular data to Excel. I have it working, but really want to implement a freeze pane on the top row for the column headings. From what I have read it's possible, and I've tried to implement bits of code I've seen, but still no dice, and I've found very little good reading on this.
Here's a similar post. I'm actually implementing the suggested code.
How to freeze the header row in an Excel spreadsheet exported from ASP.NET
Here's the code used to generate the output:
Dim html_response As String = ""
html_response &= "<html xmlns:x=""urn:schemas-microsoft-com:office:excel"">" & vbCrLf
html_response &= "<head>" & vbCrLf
html_response &= " <meta http-equiv=""Content-Type"" content=""text/htmlcharset=windows-1252"">" & vbCrLf
html_response &= " <!--[if gte mso 9]>" & vbCrLf
html_response &= " <xml>" & vbCrLf
html_response &= " <x:ExcelWorkbook>" & vbCrLf
html_response &= " <x:ExcelWorksheets>" & vbCrLf
html_response &= " <x:ExcelWorksheet>" & vbCrLf
html_response &= " <x:Name>WorkSheet Name</x:Name>" & vbCrLf
html_response &= " <x:WorksheetOptions>" & vbCrLf
html_response &= " <x:Selected/>" & vbCrLf
html_response &= " <x:FreezePanes/>" & vbCrLf
html_response &= " <x:FrozenNoSplit/>" & vbCrLf
html_response &= " <x:SplitHorizontal>1</SplitHorizontal>" & vbCrLf
html_response &= " <x:TopRowBottomPane>1</TopRowBottomPane>" & vbCrLf
html_response &= " <x:Panes>" & vbCrLf
html_response &= " <x:Pane>" & vbCrLf
html_response &= " <x:Number>3</x:Number>" & vbCrLf
html_response &= " <x:Pane>" & vbCrLf
html_response &= " <x:Pane>" & vbCrLf
html_response &= " <x:Number>2</x:Number>" & vbCrLf
html_response &= " <x:Pane>" & vbCrLf
html_response &= " </x:Panes>" & vbCrLf
html_response &= " <x:ActivePane>2</x:ActivePane>" & vbCrLf
html_response &= " <x:ProtectContents>False</x:ProtectContents>" & vbCrLf
html_response &= " <x:ProtectObjects>False</x:ProtectObjects>" & vbCrLf
html_response &= " <x:ProtectScenarios>False</x:ProtectScenarios>" & vbCrLf
html_response &= " </x:WorksheetOptions>" & vbCrLf
html_response &= " </x:ExcelWorksheet>" & vbCrLf
html_response &= " </x:ExcelWorksheets>" & vbCrLf
html_response &= " </x:ExcelWorkbook>" & vbCrLf
html_response &= " </xml>" & vbCrLf
html_response &= " <![endif]-->" & vbCrLf
html_response &= "</head>" & vbCrLf
html_response &= "<body>" & vbCrLf
'Tabular data retrieved from Session var
html_response &= table_data
html_response &= "</body>" & vbCrLf
html_response &= "</html>" & vbCrLf
'Browser/header stuff
Dim filename As String = Session("UserLoggedIn") & "_" & DateTime.Now().ToFileTime() & ".xls"
Response.Clear()
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader("content-disposition", "attachment filename=" & filename)
Response.Write(html_response)
And here's a picture showing what I get each time in Excel (I'm using Excel 2007):
As you can see, Excel is consuming the data, but no freeze pane at the top, AND it appears that some of the XML WorkSheetOptions variables are being printed in cell A1.
NOTE: I have almost no idea how the panes and their numbers play into all this, and I'm having a terrible time finding documentation. I'd be glad to read and learn if I could find something.
Any idea what I'm doing wrong here?
EDIT: Thought I would post what finally solved my issue, in case some other poor soul needs it. Only took an entire day of fiddling around.
This first function prepares the final XML for export via Response.Write, which is opened on the client machine in Excel, if they have it installed.
Public Shared Function FormatBasicSpreadsheet(excel_table_data As String, worksheet_name As String) As String
Dim html As String = ""
'The first two lines make sure Windows opens this document with Excel
html &= "<?xml version=""1.0""?>" & vbCrLf
html &= "<?mso-application progid=""Excel.Sheet""?>" & vbCrLf
html &= "<Workbook xmlns=""urn:schemas-microsoft-com:office:spreadsheet""" & vbCrLf
html &= " xmlns:o=""urn:schemas-microsoft-com:office:office""" & vbCrLf
html &= " xmlns:x=""urn:schemas-microsoft-com:office:excel""" & vbCrLf
html &= " xmlns:ss=""urn:schemas-microsoft-com:office:spreadsheet""" & vbCrLf
html &= " xmlns:html=""http://www.w3.org/TR/REC-html40"">" & vbCrLf
'Add styling for rows/cells
html &= "<Styles>" & vbCrLf
html &= " <Style ss:ID=""Default"" ss:Name=""Normal"">" & vbCrLf
html &= " <Alignment ss:Vertical=""Bottom""/>" & vbCrLf
html &= " <Borders/>" & vbCrLf
html &= " <Font ss:FontName=""Calibri"" x:Family=""Swiss"" ss:Size=""11"" ss:Color=""#000000""/>" & vbCrLf
html &= " <Interior/>" & vbCrLf
html &= " <NumberFormat/>" & vbCrLf
html &= " <Protection/>" & vbCrLf
html &= " </Style>" & vbCrLf
html &= " <Style ss:ID=""header_bold"">" & vbCrLf
html &= " <Alignment ss:Vertical=""Bottom"" ss:WrapText=""0""/>" & vbCrLf
html &= " <Font ss:FontName=""Calibri"" x:Family=""Swiss"" ss:Size=""11"" ss:Color=""#000000"" ss:Bold=""1""/>" & vbCrLf
html &= " <Borders>" & vbCrLf
html &= " <Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " </Borders>" & vbCrLf
html &= " <Interior ss:Color=""#F2F2F2"" ss:Pattern=""Solid""/>" & vbCrLf
html &= " </Style>" & vbCrLf
html &= " <Style ss:ID=""all_borders"">" & vbCrLf
html &= " <Borders>" & vbCrLf
html &= " <Border ss:Position=""Bottom"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " <Border ss:Position=""Left"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " <Border ss:Position=""Right"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " <Border ss:Position=""Top"" ss:LineStyle=""Continuous"" ss:Weight=""1""/>" & vbCrLf
html &= " </Borders>" & vbCrLf
html &= " <Interior ss:Color=""#F2F2F2"" ss:Pattern=""Solid""/>" & vbCrLf
html &= " </Style>" & vbCrLf
html &= "</Styles>" & vbCrLf
html &= "<Worksheet ss:Name=""" & worksheet_name & """>" & vbCrLf
'Tabular retrieved from Session var
'NOTE: MUST be in proper Excel XML table format.
html &= excel_table_data & vbCrLf
'Worksheet options - freeze panes, etc.
html &= "<WorksheetOptions xmlns=""urn:schemas-microsoft-com:office:excel"">" & vbCrLf
html &= " <Selected/>" & vbCrLf
html &= " <FreezePanes/>" & vbCrLf
html &= " <FrozenNoSplit/>" & vbCrLf
html &= " <SplitHorizontal>1</SplitHorizontal>" & vbCrLf
html &= " <TopRowBottomPane>1</TopRowBottomPane>" & vbCrLf
html &= " <ActivePane>2</ActivePane>" & vbCrLf
html &= " <Panes>" & vbCrLf
html &= " <Pane>" & vbCrLf
html &= " <Number>3</Number>" & vbCrLf
html &= " </Pane>" & vbCrLf
html &= " <Pane>" & vbCrLf
html &= " <Number>2</Number>" & vbCrLf
html &= " <ActiveRow>0</ActiveRow>" & vbCrLf
html &= " </Pane>" & vbCrLf
html &= " </Panes>" & vbCrLf
html &= " <ProtectObjects>False</ProtectObjects>" & vbCrLf
html &= " <ProtectScenarios>False</ProtectScenarios>" & vbCrLf
html &= "</WorksheetOptions>" & vbCrLf
html &= "</Worksheet>" & vbCrLf
html &= "</Workbook>" & vbCrLf
Return html
End Function
Hopefully, this might help someone down the road. Cheers.
Here's a function for formatting Excel XML table data, the result of which is fed to the function above.
Public Shared Function CreateExcelXmlTableFromSQL(ByVal SQL As String, IncludeHeaderStyling As Boolean) As String
Dim html As String = ""
'These variables are for setting the column width declarations
Dim column_width_template As String = "<Column ss:Width=""$$$""/>"
Dim column_character_pixel_constant As Single = 5.5 'Pixels per character
Dim column_list As New Generic.Dictionary(Of Int32, Int32)
'Open dbase connection
Dim conn As SqlConnection = dbase.CreateSqlConnection()
'Fill the datareader
Dim dr As SqlDataReader = dbase.ReturnDataReader(conn, Sql)
'Check the datareader
If (dr Is Nothing) OrElse (dr.IsClosed) Then
Return ""
End If
'Begin the table
html &= "<Table>" & vbCrLf
'Put columns placeholder in
html &= "[COLUMNS]" & vbCrLf
'NOTE: The datareader object (unlike the old ADODB recordset) is forward only. This means
' means that there is no reset of the pointer. When you read the first row to get
' the column names, you MUST also generate the first row of content, or you'll be missing
' one row.
'Read the first row of the datareader for the column headings, PLUS the first row of data.
While (dr.Read)
'Write table headers
'NOTE: This contains XML style tags
Dim header_row_style As String = " ss:StyleID=""all_borders"""
Dim header_cell_style = " ss:StyleID=""header_bold"""
If (Not IncludeHeaderStyling) Then
header_row_style = ""
header_cell_style = ""
End If
html &= "<Row" & header_row_style & ">" & vbCrLf
For i As Int16 = 0 To dr.FieldCount - 1
'NOTE: you see the styleID I included here. In billing_export_report where I
'build the overall Excel XML doc, I define this.
html &= "<Cell" & header_cell_style & "><Data ss:Type=""String""> " & dr.GetName(i) & "</Data></Cell>" & vbCrLf
column_list.Add(i, dr.GetName(i).Length)
Next
html &= "</Row>" & vbCrLf
'Write the first row of data
html &= "<Row>" & vbCrLf
For i As Int16 = 0 To dr.FieldCount - 1
html &= "<Cell><Data ss:Type=""String""> " & dr(i).ToString() & "</Data></Cell>" & vbCrLf
If (column_list.Item(i) < dr(i).ToString().Length) Then
column_list.Item(i) = dr(i).ToString().Length
End If
Next
html &= "</Row>" & vbCrLf
'Exit this loop after first row
Exit While
End While
'Write the content, starting at the second row, switching row colors.
While (dr.Read)
'Start row
html &= "<Row>" & vbCrLf
'Write the row contents
For i As Int16 = 0 To dr.FieldCount - 1
html &= "<Cell><Data ss:Type=""String""> " & dr(i) & "</Data></Cell>" & vbCrLf
If (column_list.Item(i) < dr(i).ToString().Length) Then
column_list.Item(i) = dr(i).ToString().Length
End If
Next
html &= "</Row>" & vbCrLf
End While
html &= "</Table>" & vbCrLf
'Now put the column declarations in, so that
'the widths are correct.
Dim columns_html As String = ""
For Each k As Generic.KeyValuePair(Of Int32, Int32) In column_list
Dim pixel_value As Single = (k.Value * column_character_pixel_constant) + 10
columns_html &= column_width_template.Replace("$$$", pixel_value.ToString()) & vbCrLf
Next
html = html.Replace("[COLUMNS]", columns_html)
dr.Close()
dr = Nothing
conn.Close()
conn.Dispose()
conn = Nothing
'Return the completed table
Return html
End Function
Here's an image of the finished Excel exported via Response.Write. You can see it has styling of the header row, freeze pane works, and column widths are set for proper display.
Finally discovered a workable solution. I posted details in the original question area above.