Web request code wont run - web

On the button click in my web page i run an sql statement, I also want to run a web request. I do not want to load anything from the web request, jsut run it. but here is the funny thing. The code that is the sql statement runs jsut fine, and then everything else below it just seems to not run.... at all. the server never receives the web request.
if i copy the code to a page and run just the web request code it works. but here it does not.
asp.net. thanks everyone. im stumped.
Imports System
Imports System.Data
Imports System.Web
Imports System.Data.SqlClient
Imports System.IO
Imports System.Net
Imports System.Text
Partial Class _Default
Inherits System.Web.UI.Page
Protected Sub btnAddDeckSize_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnAddDeckSize.Click
If txtDeckSize.Text > "" And txtNewDeckPrice.Text > "" Then
Dim WasError As Boolean = False
Dim SQLstring As String = "Server=server;Database=SecondLifeDatabases;Integrated Security=true"
Dim SQLconn As SqlConnection
Dim SQLcmd As New SqlCommand()
SQLconn = New SqlConnection(SQLstring)
Try
SQLconn.Open()
SQLcmd.Connection = SQLconn
Try
SQLcmd.CommandText = ("INSERT INTO [SecondLifeDatabases].[dbo].[YuGiOh-DecksAndPrices]([DeckSize] ,[PriceInLindins])VALUES (" + txtDeckSize.Text + "," + txtNewDeckPrice.Text + ")")
SQLcmd.ExecuteNonQuery()
Catch ex As Exception
Context.Response.Write("error:" + vbCrLf + " " + vbCrLf + "Unable to insert sql data, Type:" + vbCrLf + " " + vbCrLf + ex.Message)
WasError = True
SQLconn.Close()
End Try
Catch ex As Exception
Context.Response.Write("error:" + vbCrLf + " " + vbCrLf + "Could not open database:" + vbCrLf + " " + vbCrLf + ex.Message)
WasError = True
SQLconn.Close()
End Try
SQLconn.Close()
If WasError = False Then
Context.Response.Redirect("~/YuGiOh.aspx")
End If
Else
Context.Response.Write("Please check your values, something is Missing")
End If
'START OF WHERE CODE SEEMS TO NOT RUN
'THIS CODE ALONE RUNS ON ANOTHER PAGE
'BUT HERE, EVEN THO THE CODE ABOVE RUNS,
'I NEVER SEE ANY RESULTS FROM THE CODE BLOW
' Create a request using a URL that can receive a post.
Dim request As WebRequest = WebRequest.Create("http://sim6103.agni.lindenlab.com:12046/cap/b936c974-cfab-c2ee-a184-4288fe0a10f8")
' Set the Method property of the request to POST.
request.Method = "POST"
' Create POST data and convert it to a byte array.
Dim postData As String = "This is a test that posts this string to a Web server."
Dim byteArray As Byte() = Encoding.UTF8.GetBytes(postData)
' Set the ContentType property of the WebRequest.
request.ContentType = "application/x-www-form-urlencoded"
' Set the ContentLength property of the WebRequest.
request.ContentLength = byteArray.Length
' Get the request stream.
Dim dataStream As Stream = request.GetRequestStream()
' Write the data to the request stream.
dataStream.Write(byteArray, 0, byteArray.Length)
' Close the Stream object.
dataStream.Close()
' Get the response.
Dim response As WebResponse = request.GetResponse()
' Display the status.
Console.WriteLine(CType(response, HttpWebResponse).StatusDescription)
' Get the stream containing content returned by the server.
dataStream = response.GetResponseStream()
' Open the stream using a StreamReader for easy access.
Dim reader As New StreamReader(dataStream)
' Read the content.
Dim responseFromServer As String = reader.ReadToEnd()
' Display the content.
Console.WriteLine(responseFromServer)
' Clean up the streams.
reader.Close()
dataStream.Close()
response.Close()
End Sub

Related

Connect Excel to Google Sheets using VBA

I'm using Excel to create a form that is linked to another sheet that acts as a database.
This is my form (worksheet's name : "Form"):
And this is part of the database (worksheet's name: "Data"):
Right now it connects using a VBA script that is activated using the "save" button (green). Here's parts of the script:
Private Sub destBook()
setFormBook
If (destinationBook Is Nothing) Then
Dim file As String
file = ThisWorkbook.Sheets("_options").Cells(2, 26).Value //"path/to/the/database/file.xlsx"
If (IsEmpty(file)) Then
ThisWorkbook.Sheets("_options").Select
ThisWorkbook.Sheets("_options").Cells(2, 26).Select
Dim m As VbMsgBoxResult
m = MsgBox("")
Else
Set destinationBook = Workbooks.Open(file)
End If
End If
End Sub
Sub SaveClick()
Dim dataIdx As Integer
dataIdx = GetIdx()
If (dataIdx >= 2) Then
destBook
If (hasLock() = False) Then
WarnNoLock
closeDst
Else
Dim mappingRng As Range: Set mappingRng = ThisWorkbook.Sheets("_mappings").Range("F2:F71")
Dim rowIdx As Integer
For rowIdx = 1 To mappingRng.Rows.count
Dim FormRange As Range
Set FormRange = mappingRng.Cells(RowIndex:=rowIdx, ColumnIndex:=1)
If FormRange <> "" Then
Dim dataCol As Integer
Dim newValue As String
dataCol = mappingRng.Cells(RowIndex:=rowIdx, ColumnIndex:=2)
newValue = ThisWorkbook.Sheets("Form").Range(FormRange).Value
destinationBook.Sheets("Data").Cells(dataIdx, dataCol).Value = newValue
End If
Next
' refresh
Application.CalculateFull
End If
' close & save
closeDst
End If
End Sub
My question : Instead of saving/re-writing the data (Form) to another Excel file (Data), is it possible to save/re-write the data (Form) to a Google Sheet document ?
My guess would be to use the sharing link, but not sure how to make it works.
you can import JsonConverter.bas into your project (Open VBA Editor, Alt + F11; File > Import File) from https://github.com/VBA-tools/VBA-JSON/releases
and make table in your excel sheet, input this code to your module
Sub ConnectSheets()
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0") 'To use POST http Request
'Get data table as JSON
tableData = JsonConverter.ConvertToJson(Sheets("Page1").ListObjects("Table1").Range.Value)
' 'Create All Json to Send
Data = "{""dataReq"": " & vbNewLine & tableData & vbNewLine & ", " & vbNewLine & " ""fname"":""pasteData""}"
Debug.Print Data
'Define the google URL
myurl = "https://script.google.com/macros/s/AKfycbzE0nm-Jz2yE4IWc7OB_ter8NrNKBL9SXuxi6cG74FeUpwCx6T9tFZyPd13dRxgaqEm/exec"
xmlhttp.Open "POST", myurl, False 'define method to use
xmlhttp.Send Data 'execute call
sGetResult = xmlhttp.ResponseText 'read response
Debug.Print sGetResult 'view response
End Sub
and put code to your google sheet, apply as webapp
function doPost(request = {}) {
const { parameter, postData: { contents, type } = {} } = request; //request data
const { dataReq = {} } = JSON.parse(contents); //content
const { fname = {} } = JSON.parse(contents); //function name
const response = {
status: "function not found: " + fname, // prepare response in function not found
data2: dataReq
}
switch (fname) { //function selection
case 'pasteData':
var output = JSON.stringify(pasteData(dataReq)) //call function with data, name and type from request
break
default:
var output = JSON.stringify(response)
break
}
return ContentService.createTextOutput(output).setMimeType(ContentService.MimeType.JSON); //response to frontend
}
function pasteData(dataReq) {
const id = '1wtGM5QL0LwIYJoU9joOO31n_kBbJJJHRFaKtIdwWOeU'; //id of Google Sheet
var sheet = SpreadsheetApp.openById(id).getSheetByName('Page1'); //sheet
sheet.clear(); //delete data
sheet.getRange(1, 1, dataReq.length, dataReq[0].length).setValues(dataReq); // paste new data
return "Numbers of sheets added: "+ dataReq.length; //return a response
}

Excel VBA Communicating with Jira using Isolated Site Minder cookies using REST

I have inherited an Excel Tracker sheet and the code originally was created by someone else who has since left the company.
We have an Excel VBA Tracker sheet which communicates with Jira and used to work fetching projects and issues without any issues until our company changed from site minder for cookies to "Isolated Site Minder" for more secure cookies, since the change over to the isolated site minder cookie authentication our Excel tracker sheet will fetch the project key from Jira without any problem but it brings the same list of 50 issues no matter which project we are querying Jira for and no matter how we change the code it wont see the issue "Key" and filter and fetch the correct issues for the project. I'm not brilliant as Excel VBA but I do understand and can follow what the code is doing and make small adjustments, but I have now inherited this tracker sheet and am not very good at the Jira code and communicating with each other
the code is as follows:
Public Function httpGet (ByVal url as String) As String()
Dim resultArray(2) as String 
Dim PostData as String
url = baseurl + url
Dim smiwhr As New SMIsolatedWinHttpRequest
With CreateObject("WinHTTP.WinHTTPrequest.5.1")
.Option(WinRequestOption_EnableRedirects) = True 
.Option(WinRequestOption_EnableHttpsToHttpRedirects) = True
smiwhr.NewRequest "GET", url
smiwhr.Send PostData
.Open "GET", url, False
.SetRequestHeader "Content-Type", "Application/json"
.SetRequestHeader "Accept", "application/json"
.SetRequestHeader "Cookie", sCookie
.Send
resultArray(0) = Status
resultArray(1) = .ResponseText
End With
httpGet = resultArray
End Function  
There is a function that gets the requests which has the code:
Public Function getRequestByPaging(ByVal projectKey as String, ByVal StartIndex as Integer, Optional maxResults As Integer, Optional fields As String) As Object
Dim resultArray() As String
Dim api as String
Dim jql As String
Dim PostData As String
api = "rest/api/2/search"
jql = "project=" & projectKey & " and issuetype!=\""Project\"" ORDER By Key ASC "
PostData = "{"
PostData = PostData + toJson ("jql", jql) + ","
PostData = PostData + toJson("StartAt", StartIndex) + ","
If maxResults <> "" Then
PostData = PostData + toArray("field", fields) + ","
End If
PostData = Mid(PostData, 1, Len(PostData) - 1)
PostData = Post + "}"
End Function  
The jql part does pick up the project key, it is when it sends the details of the project through to the Json that it returns the wrong issue key 
The Json function is as follows:
Public Function toJson (byVal As String, ByVal value As String) As String
If value = "" Then
toJson = """" + key + """ : null"
Else
toJson = """" + key + """ : """ + value + """"
End If
End Function
Any help would be very much appreciated
While editing your original question and adding syntax highlighting to it (otherwise your code cannot be read), I've noticed that the syntax in the function in question is probably wrong:
You had it:
If value = "" Then
toJson = """ + key + """ : null"
' ^^^ missing "
Else
toJson = """" + key + """ : """ + value """"
' ^ missing +
End If
It should be this way:
If value = "" Then
toJson = """" + key + """ : null"
Else
toJson = """" + key + """ : """ + value + """"
End If

Accessing SurveyMonkey API from VBA

I am tying to set-up a Excel VBA project to readout individual survey responses into a form in Excel for some calculations and then PDF reporting.
However I have great difficulty to deploy the .NET library (SurveyMonkeyApi) to be available for reference in VBA.
I have set up a VisualStudio project to test that way , and I can install it for that specific VS project (through NuGet PM). But the library is not made available for Excel on that machine.
I have downloaded (on another machine) the libraries through standalone NuGet and they download OK but then I am at loss on how to register for Excel VBA access. On top of it there is a dependency on NewtonsoftJson library too (which downloaded automatically on both occasions).
Good advice appreciated!
I just saw this now - is there a feature for StackOverflow to alert me when a comment is added or a question answered, so I know to look back?
Here is starting code:
Option Explicit
Public Const gACCESS_TOKEN As String = "xxxxxxxxxxxxxxxxxxxxxx"
Declare Function GetTickCount Lib "kernel32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
' for a JSON parser see https://code.google.com/p/vba-json/
Public Sub test()
Dim vRequestBody As Variant, sResponse As String, sSurveyID As String
sSurveyID = "1234567890"
vRequestBody = "{""survey_id"":" & """" & sSurveyID & """" _
& ", ""fields"":[""collector_id"", ""url"", ""open"", ""type"", ""name"", ""date_created"", ""date_modified""]" _
& "}"
sResponse = SMAPIRequest("get_collector_list", vRequestBody)
End Sub
Function SMAPIRequest(sRequest As String, vRequestBody As Variant) As String
Const SM_API_URI As String = "https://api.surveymonkey.net/v2/surveys/"
Const SM_API_KEY As String = "yyyyyyyyyyyyyyyyyyyyyyyy"
Dim bDone As Boolean, sMsg As String, sUrl As String, oHttp As Object ' object MSXML2.XMLHTTP
Static lsTickCount As Long
If Len(gACCESS_TOKEN) = 0 Then
Err.Raise 9999, "No Access token"
End If
On Error GoTo OnError
sUrl = SM_API_URI & URLEncode(sRequest) & "?api_key=" & SM_API_KEY
'Debug.Print Now() & " " & sUrl
Application.StatusBar = Now() & " " & sRequest & " " & Left$(vRequestBody, 127)
Set oHttp = CreateObject("MSXML2.XMLHTTP") ' or "MSXML2.ServerXMLHTTP"
Do While Not bDone ' 4.33 offer retry
If GetTickCount() - lsTickCount < 1000 Then ' if less than 1 sec since last call, throttle to avoid sResponse = "<h1>Developer Over Qps</h1>"
Sleep 1000 ' wait 1 second so we don't exceed limit of 2 qps (queries per second)
End If
lsTickCount = GetTickCount()
'Status Retrieves the HTTP status code of the request.
'statusText Retrieves the friendly HTTP status of the request.
'Note The timeout property has a default value of 0.
'If the time-out period expires, the responseText property will be null.
'You should set a time-out value that is slightly longer than the expected response time of the request.
'The timeout property may be set only in the time interval between a call to the open method and the first call to the send method.
RetryPost: ' need to do all these to retry, can't just retry .Send apparently
oHttp.Open "POST", sUrl, False ' False=not async
oHttp.setRequestHeader "Authorization", "bearer " & gACCESS_TOKEN
oHttp.setRequestHeader "Content-Type", "application/json"
oHttp.send CVar(vRequestBody) ' request body needs brackets EVEN around Variant type
'-2146697211 The system cannot locate the resource specified. => no Internet connection
'-2147024809 The parameter is incorrect.
'String would return {"status": 3, "errmsg": "No oJson object could be decoded: line 1 column 0 (char 0)"} ??
'A Workaround would be to use parentheses oHttp.send (str)
'"GET" err -2147024891 Access is denied.
'"POST" Unspecified error = needs URLEncode body? it works with it but
SMAPIRequest = oHttp.ResponseText
'Debug.Print Now() & " " & Len(SMAPIRequest) & " bytes returned"
sMsg = Len(SMAPIRequest) & " bytes returned in " & (GetTickCount() - lsTickCount) / 1000 & " seconds: " & sRequest & " " & Left$(vRequestBody, 127)
If Len(SMAPIRequest) = 0 Then
bDone = MsgBox("No data returned - do you wish to retry?" _
& vbLf & sMsg, vbYesNo, "Retry?") = vbNo
Else
bDone = True ' got reply.
End If
Loop ' Until bdone
Set oHttp = Nothing
GoTo ExitProc
OnError: ' Pass True to ask the user what to do, False to raise to caller
Select Case MsgBox(Err.Description, vbYesNoCancel, "SMAPIRequest")
Case vbYes
Resume RetryPost
Case vbRetry
Resume RetryPost
Case vbNo, vbIgnore
Resume Next
Case vbAbort
End
Case Else
Resume ExitProc ' vbCancel
End Select
ExitProc:
End Function
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long
StringLen = Len(StringVal)
If StringLen > 0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
EDIT 23-APRIL add more code.
the Me. comes from code in a Userform.
Set jLib = New JSONLib
vRequestBody = "{"
If Me.txtDaysCreated > "" Then
vRequestBody = vRequestBody & JKeyValue("start_date", Format$(Now() - CDbl(Me.txtDaysCreated), "yyyy-mm-dd")) & ","
End If
If Me.txtTitleContains > "" Then
' title contains "text", case insensitive
vRequestBody = vRequestBody & JKeyValue("title", Me.txtTitleContains) & ","
End If
vRequestBody = vRequestBody _
& JKeyValue("fields", Array("title", "date_created", "date_modified", "num_responses", _
"language_id", "question_count", "preview_url", "analysis_url")) & "}"
'returns in this order: 0=date_modified 1=title 2=num_responses 3=date_created 4=survey_id
' and in date_created descending
sResponse = GetSMAPIResponse("get_survey_list", vRequestBody)
------------------------------------------
Function JKeyValue(sKey As String, vValues As Variant) As String
Dim jLib As New JSONLib
JKeyValue = jLib.toString(sKey) & ":" & jLib.toString(vValues)
Set jLib = Nothing
End Function
Edit 25-April overview of VBA code to get the data
This is covered in the SM documentation, but I'll sketch how that looks in VBA.
the response to get_survey_details gives you all the survey setup data. Use
Set oJson = jLib.parse(Replace(sResponse, "\r\n", " "))
to get a json object.
Set dictSurvey = oJson("data")
gives you the dictionary so you can get data like dictSurvey("num_responses"). I take it you know how to index into dictionary objects to get field values.
Set collPages = dictSurvey("pages")
gives you a collection of Pages. The undocumented field "position" gives you the order of pages in the survey UI.
For lPage = 1 To collPages.Count
Set dictPage = collPages(lPage)
Set collPageQuestions = dictPage("questions") ' gets you the Qs on this page
For lPageQuestion = 1 To collPageQuestions.Count
Set dictQuestion = collPageQuestions(lPageQuestion) ' gets you one Q
Set collAnswers = dictQuestion("answers") ' gets the QuestionOptions for this Q
For lAnswer = 1 To collAnswers.Count
Set dictAnswer = collAnswers(lAnswer) ' gets you one Question Option
etc etc
Then given the number of responses from above, loop through the respondents 100 at a time - again see the SM doc for details of how to specify start and end dates to do incremental downloads over time.
create a json object from the response to "get_respondent_list"
Collect the fields for each respondent and accumulate a list of at most 100 respondent IDs.
Then "get_responses" for that list.
Set collResponsesData = oJson("data")
For lResponse = 1 To collResponsesData.Count
If not IsNull(collResponsesData(lResponse)) then
... get fields...
Set collQuestionsAnswered = collResponsesData(lResponse)("questions")
For lQuestion = 1 To collQuestionsAnswered.Count
Set dictQuestion = collQuestionsAnswered(lQuestion)
nQuestion_ID = CDbl(dictQuestion("question_id"))
Set collAnswers = dictQuestion("answers") ' this is a collection of dictionaries
For lAnswer = 1 To collAnswers.Count
On Error Resume Next ' only some of these may be present
nRow = 0: nRow = CDbl(collAnswers(lAnswer)("row"))
nCol = 0: nCol = CDbl(collAnswers(lAnswer)("col"))
nCol_choice = 0: nCol_choice = CDbl(collAnswers(lAnswer)("col_choice"))
sText = "": sText = collAnswers(lAnswer)("text")
nValue = 0: nValue = Val(sText)
On Error GoTo 0
and save all those values in a recordset or sheet or whatever
Hope that helps.
I access the SM API in straight VBA.
Just CreateObject("MSXML2.XMLHTTP") then issue calls and use the SimpleJsON JSONLib to parse it.
If I wanted to access VB.Net code, I'd package it with ExcelDNA to create a XLL and that gives a straight Excel addin.
I would think you would need to add it into the References for your Excel project.
From the Ribbon, select, Tools, then References, then scroll through the list looking for something about SurveyMonkey API.
So encouraged by #sysmod I have tried to do something in VBA directly. I have left out the JSON for now as I am already in trouble. The below is giving me "Developer Inactive" as a result, though I have another project in VB.NET where the same key and token works fine.
Public Sub GetSMList()
Dim apiKey As String
Dim Token As String
Dim sm As Object
apiKey = "myKey"
Token = "myToken"
Set sm = CreateObject("MSXML2.XMLHTTP.6.0")
With sm
.Open "POST", "https://api.surveymonkey.net/v2/surveys/get_survey_list", False
.setRequestHeader "Authorization", "Bearer " & Token
.setRequestHeader "Content-Type", "application/json"
.send "api_key=" & apiKey
result = .responseText
End With
End Sub

get a field value from a webpage - lotusscript

I need to read the field value from a webpage using lotusscript. Essentially I am planning on writing an agent to go to a specific URL, get a value from the page, and then use this value for the url it sends the user to.
Can anyone give me a pointer?
A
Update December 2019: As of Notes 10 (released in 2018) there is a NotesHTTPRequest class that does exactly the same thing as my code.
I do this all the time, it is not hard at all (on Windows). I created a class to do this, so it is very easy to implement.
Here is how you call it:
Dim internet As New RemoteHTML()
Dim html As String
html = internet.GetHTTP("http://www.texasswede.com/mypage.html")
That's it, now you just pull whatever information you want out of the html string.
Here is the class:
Option Public
Option Declare
Class RemoteHTML
Private httpObject As Variant
Public httpStatus As Integer
Public Sub New()
Set httpObject = CreateObject("MSXML2.ServerXMLHTTP")
End Sub
Public Function GetHTTP(httpURL As String) As String
Dim retries As Integer
retries = 0
Do
If retries>1 Then
Sleep 1 ' After the two first calls, introduce a 1 second delay betwen each additional call
End If
retries = retries + 1
Call httpObject.open("GET", httpURL, False)
Call httpObject.send()
httpStatus = httpObject.Status
If retries >= 10 Then
httpStatus = 0 ' Timeout
End If
Loop Until httpStatus = 200 Or httpStatus > 500 Or httpStatus = 404 Or httpStatus = 0
If httpStatus = 200 Then
GetHTTP = Left$(httpObject.responseText,16000)
Else
GetHTTP = ""
End If
End Function
Public Function GetFile(httpURL As String, filename As String) As Boolean
Dim session As New NotesSession
Dim retries As Integer
Dim stream As NotesStream
Dim flag As Boolean
Dim responsebody As variant
Dim cnt As Long
Dim buffer As String
Dim tmp As Byte
Set stream = session.CreateStream
retries = 0
Do
If retries>1 Then
Sleep 1 ' After the two first calls, introduce a 1 second delay betwen each additional call
End If
retries = retries + 1
Call httpObject.open("GET", httpURL, False)
Call httpObject.send()
httpStatus = httpObject.Status
If retries >= 10 Then
httpStatus = 0 ' Timeout
End If
Loop Until httpStatus = 200 Or httpStatus > 500 Or httpStatus = 404 Or httpStatus = 0
If httpStatus = 200 Then
flag = stream.Open(filename, "binary")
If flag = False Then
MsgBox "Failed to create " & filename & "..."
GetFile = False
Exit function
End If
responsebody = httpObject.ResponseBody
ForAll r in responsebody
tmp = r
Call Stream.Write(Chr$(CInt(tmp)))
cnt = cnt + 1
End ForAll
MsgBox cnt
GetFile = True
Else
GetFile = False
End If
End Function
Private Function getString(ByVal StringBin As string)
Dim intCount As Long
getString =""
For intCount = 1 To LenB(StringBin)
getString = getString & Chr( Asc(MidB(StringBin, intCount, 1)) )
Next
End Function
End Class
If your code will be running on Windows, you can use either WinHTTP or XMLHTTP COM classes to read web pages. If the code will be running on any other platform, you will be better off using Java instead of LotusScript.
If You're trying to read form a NotesField, you could go for below approach. Tha Class was created to specifically handle export of RichText items into html-strings in order to find the otherwise kind-of-hidden embedded images (pasted graphics) that may exist in NotesRichText items.
The function ExportDoc() copies the html response text into a user defined field on the document at hand:
Public Class RTExporter
session As NotesSession
db As NotesDatabase
doc As NotesDocument
obj As Variant
url As String
Public Sub New()
Set Me.session = New NotesSession()
Set db = session.CurrentDatabase
Set obj = CreateObject("Microsoft.XMLHTTP")
End Sub
' Handles export from eventual NotesRichTextitems in the form of HTml
Public Function ExportDoc(hostUrl As String, doc As NotesDocument, rtFieldName As String, htmlFieldName As String)
Dim htmlString As String
url = hostUrl & Me.db.FilePath & "/0/" & doc.Universalid & "/" & rtFieldname & "?openfield&charset=utf-8
Set Me.doc = doc
htmlString = GetHtmlFromField(htmlFieldName)
Call doc.ReplaceItemValue(htmlFieldName, htmlString)
Call doc.Save(True, False)
End Function
' Get http response text and store it in <fieldname>
Private Function GetHtmlFromField(rtFieldName As String) As String
Dim html As String
On Error Goto ERH
obj.open "GET", Me.url, False, "", ""
obj.send("")
GetHtmlFromField = Trim$(obj.responseText)
Exit Function
ERH:
GetHtmlFromField = "Error " & Err & ": " & Error & " occured on line: " & Erl
End Function
End Class

IIS7 Response.WriteBuffer not working

We have an ASP.NET 1.1 application that uses Crystal Reports to spit out an excel spreadsheet. The codes works under IIS6 but when we try to migrate it to IIS7 it is spitting out html with no content instead of the Excel file.
The MIME Type exists. Below is the code we are using. I did not write this code as I'm working primarily in 3.5 framework now. My assumption is I am missing something in the IIS7 configuration not the code since it works on IIS6. The rest of the ASP.NET 1.1 application works on IIS7.
Dim cr As ReportClass
'EXPORT the report based on the export type passed in.
Dim ExpOptions As New ExportOptions
Dim ContentType As String
Dim strExt As String
Trace.Write("DisplayReport reportname=" + ReportName + " SQL=" + SQL + " SQLSub1=" + Convert.ToString(Session("SQLSub1")))
'Get the report filled with the data.
If Session("SQLSub1") <> "" Then
If Not Session("SubRptName") Is Nothing Then
cr = PopulateReport(GetReportObject(ReportName), SQL, Session("SQLSub1"), Session("SubRptName"))
Session("SQLSub1") = ""
Session("SubRptName") = Nothing
Else
cr = PopulateReport(GetReportObject(ReportName), SQL, Session("SQLSub1"))
Session("SQLSub1") = ""
End If
Else
cr = PopulateReport(GetReportObject(ReportName), SQL)
End If
If DisplayType = ReportType.Excel Then
If ReportName.ToUpper = "ACTION" Or ReportName.ToUpper = "INVENTORY_EXCEL" _
Or ReportName.ToUpper = "UNDERPERFORM" Or ReportName.ToUpper = "EMPLOYEE_EXCEL" Then
Dim excelFormatOpts As New ExcelFormatOptions
' Set the excel format options.
excelFormatOpts.ExcelTabHasColumnHeadings = True
excelFormatOpts.ExcelUseConstantColumnWidth = False
ExpOptions.FormatOptions = excelFormatOpts
Else
ExpOptions.FormatOptions = New ExcelFormatOptions
End If
ExpOptions.ExportFormatType = ExportFormatType.Excel
ContentType = "application/vnd.ms-excel"
strExt = ".xls"
ElseIf DisplayType = ReportType.PDF Then
ExpOptions.ExportFormatType = ExportFormatType.PortableDocFormat
ExpOptions.FormatOptions = New PdfRtfWordFormatOptions
ContentType = "application/pdf"
strExt = ".pdf"
End If
'Stream the report to the screen
Dim req As New ExportRequestContext
req.ExportInfo = ExpOptions
Dim s As Stream
Try
s = cr.FormatEngine.ExportToStream(req)
Catch ex As Exception
Trace.Warn("DisplayReport cr.FormatEngine.ExportToStream(req) failed: " + ex.Message)
Dim x As String = String.Empty
End Try
Response.Clear()
'Response.ClearHeaders()
'Response.ClearContent()
Response.Buffer = True
Response.ContentType = ContentType
Response.AddHeader("Content-Type", ContentType)
Dim buffer(s.Length) As Byte
s.Read(buffer, 0, Int(s.Length))
Response.BinaryWrite(buffer)
Dim strContentDisposition As String = "inline;filename=" & ReportName.ToString.ToLower & strExt.ToString
Trace.Write("DisplayReport strContentDisposition=" + strContentDisposition)
Response.AddHeader("Content-Disposition", strContentDisposition)
Response.Cache.SetMaxAge(New TimeSpan(0, 0, 10))
Response.End()
Asked some devs here at work, this is what I got so far:
"Never seen that before, I’ve never even used the export to stream option in crystal before. However, if I were to guess, I would look at server permissions as a possible fault. I’ve seen situations where the user has to have special privileges to access streams."

Resources