GetListitems not returning expected result - sharepoint

I have created a windows application using list.asmx (getlistitems method) to download documents from a document library which is on another server. I am able to access document names, url, etc. When I use following code to download a file, it is returning html of the login page as content of each file that I am trying to download.
Any thoughts?
Dim spAuthentication As New Authentication()
spAuthentication.Url = authenticationWSAddress
spAuthentication.CookieContainer = New CookieContainer()
Dim spLists As New Lists()
spLists.Url = listWSAddress
'Try to login to SharePoint site with Form based authentication
Dim loginResult As LoginResult = spAuthentication.Login(userName, password)
Dim cookie As New Cookie()
'If login is successfull
If loginResult.ErrorCode = LoginErrorCode.NoError Then
'Get the cookie collection from the authenticatin web service
Dim cookies As CookieCollection = spAuthentication.CookieContainer.GetCookies(New Uri(spAuthentication.Url))
'Get the specific cookie which contains the security token
cookie = cookies(loginResult.CookieName)
'Initialize the cookie container of the list web service
spLists.CookieContainer = New CookieContainer()
'set the cookie of list web service to the authenticatio cookie
spLists.CookieContainer.Add(cookie)
'Dim responseNode As XmlNode = spLists.GetListCollection()
'response = responseNode.InnerXml
Dim query As String = "<mylistitems><Query><Where><Eq><FieldRef Name='FileDirRef' /><Value Type='Url'>DocLib/Property Documents/BELASERA AT FULTON (lax10027)/Master Meter Invoices</Value></Eq></Where></Query><QueryOptions><ViewAttributes Scope='RecursiveAll' IncludeRootFolder='False' /><IncludeAttachmentUrls>TRUE</IncludeAttachmentUrls><ViewFields><FieldRef Name='EncodedAbsUrl'/></ViewFields></QueryOptions></mylistitems>"
Dim doc As New XmlDocument()
doc.LoadXml(query)
Dim dt As DataTable = Nothing
Dim queryNode As XmlNode = doc.SelectSingleNode("//Query")
Dim viewNode As XmlNode = doc.SelectSingleNode("//ViewFields")
Dim optionNode As XmlNode = doc.SelectSingleNode("//QueryOptions")
Dim retNode As XmlNode = spLists.GetListItems("DocLib", String.Empty, queryNode, viewNode, String.Empty, optionNode, Nothing)
Dim ds As New DataSet()
Using sr As New StringReader(retNode.OuterXml)
ds.ReadXml(sr)
End Using
If ds.Tables("Row") IsNot Nothing AndAlso ds.Tables("Row").Rows.Count > 0 Then
dt = ds.Tables("Row").Copy()
For Each myrow As DataRow In dt.Rows
' myrow.Item(0) contains url of the document
If myrow.Item(0) IsNot Nothing AndAlso myrow.Item(0) <> "" Then
DownLoadAttachmentold(myrow.Item("ows_EncodedAbsUrl"), RemoveLookupID(myrow.Item("ows_FileLeafRef")))
End If
Next
End If
Public Shared Sub DownLoadAttachment(ByVal strURL As String, ByVal strFileName As String)
Dim myWebClient As New WebClient()
Dim DestinationFolder As String = "C:\\DownLoads\\"
Form2.RTBStatus.AppendText("Downloading File " + strFileName + " from " + strURL + " .......")
' The DownloadFile() method downloads the Web resource and saves it into the current file-system folder.
myWebClient.DownloadFile(strURL, DestinationFolder + strFileName)
'Form2.RTBStatus.AppendText("Successfully Downloaded file ""{0}"" from ""{1}""", "C:\\DownLoads\\" + strFileName, strURL)
Form2.RTBStatus.AppendText((ControlChars.Cr + "Downloaded file saved in the following file system folder:" + ControlChars.Cr + ControlChars.Tab + DestinationFolder))
End Sub

DownloadAttachment also needs to make (forms-based) authenticated HTTP requests.
An example in C# below:
request = (HttpWebRequest)WebRequest.Create(strURL);
request.Credentials = System.Net.CredentialCache.DefaultCredentials;//adapt for your FBA
request.AllowWriteStreamBuffering = false;
response = (HttpWebResponse)request.GetResponse();
Stream s = response.GetResponseStream();
FileStream fs = new FileStream(#"C:\DownLoads\"+strFileName, FileMode.Create);

Related

VBA Macro, get URL from given range loop and pull XML node

I have this code that is set up to get data ZIP code (single node) from an XML URL. However, I actually have a list of URLs in Sheet1, Column B that I need to loop through until all the data is extracted.
I dont want to have to update the code each time individually per URL. There are thousands... How would i be able to do that?
Here's an example of a working code for a single URL:
Sub test1()
Dim xmlDocument As MSXML2.DOMDocument60
Dim URL As String
Dim node As Object
Set xmlDocument = New DOMDocument60
URL = Sheets("Sheet1").Range("b2").Value
'Open XML page
Set xmlDocument = New MSXML2.DOMDocument60
xmlDocument.async = False
xmlDocument.validateOnParse = False
xmlDocument.Load URL
Dim nodeId As IXMLDOMNode
Dim nodeId2 As IXMLDOMNode
Set nodeId = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip5")
Set nodeId2 = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip4")
If Not nodeId Is Nothing Then
Sheets("fy2016").Range("e2").Value = nodeId.Text & " " & nodeId2.Text
Else
Sheets("fy2016").Range("e2").Value = "'ZIP code' was not found."
End If
End Sub
Assuming your code works you want something like a For Loop over all the urls. Move your document outside of the loop and load it inside the loop. I use an array to store the urls read in from the sheet for faster handling. Your construct wasn't handling any errors on parse so I have commented out related lines.
Not tested.
Option Explicit
Public Sub test1()
Dim xmlDocument As MSXML2.DOMDocument60, URLs(), i As Long
Dim node As Object, nodeId As IXMLDOMNode, nodeId2 As IXMLDOMNode
Set xmlDocument = New DOMDocument60
URLs = ThisWorkbook.Worksheets("Sheet1").Range("B2:B1000").Value
Set xmlDocument = New MSXML2.DOMDocument60
xmlDocument.async = False
' xmlDocument.validateOnParse = False
For i = LBound(URLs, 1) To UBound(URLs, 1)
xmlDocument.Load URLs(i, 1)
Set nodeId = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip5")
Set nodeId2 = xmlDocument.SelectSingleNode("/ZipCodeLookupResponse/Address/Zip4")
If Not nodeId Is Nothing Then
ThisWorkbook.Worksheets("fy2016").Cells(i + 1, "E").Value = nodeId.Text & " " & nodeId2.Text
Else
ThisWorkbook.Worksheets("fy2016").Cells(i + 1, "E").Value = "'ZIP code' was not found."
End If
Set nodeId = Nothing: Set nodeId2 = Nothing
Next
End Sub

Error Sending automation mail after registration using lotus script

Question:
1. My question why after registration of an user still not listed in domino directory?
Case:
I am using xPages form call lotus script agent.
All my script is using lotus script to register an user.
After Complete register an email, need to send automation notification mail to user as welcome mail.
when i complete registration, i want to send mail, it give me an error message:
1.unable to deliver message 'ChunWH#devsvr1.pcs.com.my'
2.User 'ChunWH#devsvr1.pcs.com.my' not listed in Domino Directory
Register user Agent
Option Public
Option Declare
Sub Initialize
On Error GoTo ErrorHandler
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim groups
groups = Null
groups = group(groups,"Everyone")
Dim certid As String ' full path of cert id
Dim certpasswd As String
Dim OU As String
Dim lastname As String
Dim firstname As String
Dim middleinit As String
Dim usrIdpath As String
Dim mailsvr As String
Dim mailfile As String
Dim userpasswd As String
Dim internetpathLength As String
Dim internetpath As String
Dim remapuserID As String
Dim depvw As NotesView, depdoc As NotesDocument
Set depvw = db.Getview("Department sort by dept")
Set depdoc = depvw.Getdocumentbykey(doc.Dept(0), True)
If Not depdoc Is Nothing Then
certid = depdoc.IdPath(0)
certpasswd = depdoc.IdPassword(0)
OU = ""
lastname= doc.Name(0)
firstname = ""
middleinit = ""
usrIdpath = depdoc.DptIdStor(0) +doc.SelectMail(0)+ ".id"
' remove "." replace with empty and remove the empty space
remapuserID = remapChr(doc.SelectMail(0)) ' this is remapuserID
mailsvr = depdoc.MailSvr(0) ' mail svr
' Mail file name also cannot have . in between for example, mail/test1.apple, reason window not understand it
mailfile = depdoc.MailLocation(0)+ remapuserID ' Mail\Person
userpasswd= depdoc.UserPassword(0)
internetpath = doc.SelectMail(0)+depdoc.InternetPath(0) ' mail address
internetpathLength = Len(depdoc.InternetPath(0)) ' not used
End If
Dim reg As New NotesRegistration
Dim dt As Variant
dt = DateNumber(Year(Today)+1, Month(Today), Day(Today))
reg.RegistrationServer = mailsvr
reg.CreateMailDb = True '
reg.CertifierIDFile = certid
reg.Expiration = dt
reg.IDType = ID_HIERARCHICAL
reg.MinPasswordLength = 1
reg.IsNorthAmerican = True
reg.OrgUnit = OU
reg.RegistrationLog = "log.nsf"
reg.UpdateAddressBook = True
reg.Storeidinaddressbook = false
reg.MailInternetAddress = internetpath
reg.Shortname=doc.SelectMail(0)
reg.Mailowneraccess =2
reg.Mailcreateftindex=True
reg.Mailaclmanager ="LocalDomainAdmins"
reg.Grouplist=groups
Call reg.RegisterNewUser(lastname, _
usridpath, _
mailsvr, _
firstname, _
middleInit, _
certpasswd, _
"", _
"", _
mailfile, _
"", _
userpasswd, _
NOTES_DESKTOP_CLIENT)
Dim acl As NotesACL
Dim aclEntry As NotesACLEntry
Dim dbUser As NotesDatabase
Set dbUser = New NotesDatabase(mailsvr,mailfile) ' mail/person.nsf
Set acl = dbUser.aCL
Set aclEntry = acl.Getentry( "LocalDomainAdmins" )
If Not (aclEntry Is Nothing) Then
aclEntry.UserType = ACLTYPE_PERSON_GROUP
Call acl.Save()
End if
' call name nsf and open for edit for forcing user must change password first time
Dim ndb As NotesDatabase
Dim viwUser As NotesView
Dim docUser As NotesDocument
Set ndb = New NotesDatabase( mailsvr, "names.nsf" )
Set viwUser = ndb.GetView("People by Email")
Set docUser = viwUser.GetDocumentByKey(doc.SelectMail(0),True)
Call docUser.ReplaceItemValue( "HTTPPasswordForceChange" , "1" )
Print "Force user change password is updated"
Call docUser.Save( True, True, True )
Print "Please wait ...... Registration in progress"
Call doc.Replaceitemvalue("S_Process", "Pending")
Call doc.Save(True, False)
Dim agt As NotesAgent
Set agt=db.getagent("(Welcome Mail)")
Call agt.Runonserver()
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
Function remapChr (oldString)
' to replace all special character with a empty space after that trim to remove all special character in system
Dim oldChr, newChr, newString As String
oldChr = {! "" # $ % & ' ( ) * + , - . / : ; = > ? # [ \ ] ^ _}
newChr = " {"
oldChr = Split(oldChr, " ")
newChr = Split(newChr, " ")
newString = Trim(Replace(LCase(oldString), oldChr, newChr))
remapChr = newString
End Function
Function group(groupArr, newReason$)
If IsArray(groupArr) Then
If groupArr(0) = "" Then
groupArr(0) = newReason
Else
Dim counter%
counter = UBound(groupArr) + 1
ReDim Preserve groupArr(counter)
groupArr(counter) = newReason
End If
group = groupArr
Else
Dim tempgroupArr() As String
ReDim tempgroupArr(0)
tempgroupArr(0) = newReason
group = tempgroupArr
End If
End Function
Sending mail Agent
Sub Initialize
On Error GoTo ErrorHandler
Print "Welcome Mail Agent started..."
' This agent is a sub agent for register user, which let register agent call
Dim s As New NotesSession, db As NotesDatabase, a As NotesAgent
Dim doc As NotesDocument
Set db = s.Currentdatabase
Set a = s.Currentagent
Set doc = s.Documentcontext ' uidoc
Dim maildoc As NotesDocument, body As NotesMIMEEntity
Dim stream As NotesStream
Dim receiver$
Dim tmpallve As NotesViewEntry
Dim viwUser As NotesView
Dim viwVe As NotesViewEntry
Dim viwVc As NotesViewEntryCollection
Dim docUser As NotesDocument
Set viwUser = db.GetView("(Request sort by S_Process)")
'Set docUser = viwUser.GetDocumentByKey("Pending",True)
Set viwVc = viwUser.Allentries
If viwVc.Count = 0 Then
Print "No item found in this list"
Exit Sub
End If
Set viwVe = viwVc.Getfirstentry()
Do While Not viwVe Is Nothing ' loop to all entry
Set docUser = viwVe.Document
receiver$ = docUser.SelectMail(0) + "#devsvr1.pcs.com.my"
' send mail
Set maildoc = db.Createdocument()
Call maildoc.Replaceitemvalue("Form", "Memo")
Call maildoc.Replaceitemvalue("Subject", "Welcome")
Call maildoc.Replaceitemvalue("SendTo", receiver)
Set body = maildoc.Createmimeentity
s.Convertmime = False
Set stream = s.Createstream()
stream.Writetext(|<html><body>|)
stream.Writetext(|<p>Your application for registration ....</p>|)
stream.Writetext(|<p>Welcome. Pleaase....</p>|)
stream.Writetext(|<p><em>(No signature requried on this computer generated document)</em></p>|)
stream.Writetext(|<p>*** This is a system generated email. | + _
|Please do not reply to this email. ***</p>|)
Call stream.Writetext(|</body></html>|)
Call body.Setcontentfromtext(stream, "text/html;charset=UTF-8", 1725)
Call maildoc.Send(False)
s.Convertmime = True
Call docUser.Replaceitemvalue("S_Process", "Processed")
Call docUser.Save(True, False)
Set tmpallve = viwVc.Getnextentry(viwVe)
Set viwVe = tmpallve
Loop
Print "Welcome Mail Agent finished..."
EndOfRoutine:
Exit Sub 'or exit function
ErrorHandler:
Print Err & ", " & Error & " in line " & Erl
Resume EndOfRoutine
End Sub
new update of image on 25/09/2017
(after set config router_debug=3 set config DebugRouterLookup=3 )
i try send manually will be fine...but using code directly send after registration will be fail. Not only that, i also try on sleep(2) , wait 2 second just send mail..it seem like my thought of not directly create mail account mail also not valid..not sure which part is wrong?
I suspect that your issue is one of time and caching. The Domino server maintains a Name Lookup Cache that only gets refreshed, well, occasionally (I have never figured out how occasionally that is but 5-10 minutes generally does the trick). This affects both the email functions and the web login functions. What I have done with my registration systems is have the agent that does the ID creation leave a document in it database that is in the status "Pending welcome email". Then another agent finds those docs and if they are more then 15 minutes old it attempts the email. if the email goes through then the status is changed to "Complete".
Note, you can reset the cache with the console command show nlcache reset and that almost always results in the user being able to get mail and login from a browser. But I have not been able to get that to work from a scheduled agent run on the server or a web agent.
Can you take a look at the Person Document? See if that address is properly registered on the document.
You may also try to enable router_debug=3 and DebugRouterLookUp=3 and we may see where did it try to lookup the address.

Convert from .csv file to .xlsx excel file

Hi
I am using an ASP.NET application and producing a report in excel page with .csv extension. However I would like to produce it with .xlsx etension.
The code I am currently using is as follows:
Protected Sub btnSubmit_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnSubmit.Click
Dim sql As String
Dim strLine As String = ""
Dim attachment As String = "attachment; filename=PTW.csv"
m_sBranch = ddlBranches.SelectedValue
m_sRegion = ddlAreas.SelectedValue
Dim cnn As SqlConnection = New SqlConnection("Server=XYZ;Database=abc;Trusted_Connection=yes;")
HttpContext.Current.Response.AddHeader("content-disposition", attachment)
HttpContext.Current.Response.ContentType = "text/csv"
cnn.Open()
sql = GetReportSql(m_sBranch, m_sRegion)
Dim cmd As SqlCommand = New SqlCommand(sql, cnn)
Dim dr As SqlDataReader
dr = cmd.ExecuteReader()
HttpContext.Current.Response.Write("PTW JOBS - EXPORTED ON " + DateTime.Now)
For i = 0 To dr.FieldCount - 1
strLine = strLine & dr.GetName(i).ToString & ","
Next
HttpContext.Current.Response.Write(strLine)
Dim sb As StringBuilder = New StringBuilder()
Dim temp As String = ""
While dr.Read()
For i = 0 To dr.FieldCount - 1
temp = temp & dr.GetValue(i)
temp = temp.Replace(",", " ")
sb.Append(temp & ",")
temp = ""
Next
sb.AppendLine()
strLine = ""
End While
HttpContext.Current.Response.Write(sb.ToString())
End Sub
Any help will be highly appreciated. Thanks.
Look into the OpenXML SDK:
I understand that my example doesn't convert .csv files, but it will steer you in the right direction.
http://msdn.microsoft.com/en-us/library/bb448854(office.14).aspx
I've used it in asp.net to create xlsx documents on the fly, streamed directly to the web client:
public static System.IO.MemoryStream ConvertToExcel(DataSet ds)
{
System.IO.MemoryStream stream = new System.IO.MemoryStream();
using (SpreadsheetDocument package = SpreadsheetDocument.Create(stream, SpreadsheetDocumentType.Workbook, true))
{
package.AddWorkbookPart();
package.WorkbookPart.Workbook = new Workbook();
package.WorkbookPart.AddNewPart<WorksheetPart>();
if (ds.Tables.Count > 0 && ds.Tables[0].Rows.Count > 0)
{
DataTable tbl = ds.Tables[0];
SheetData xlSheetData = new SheetData();
foreach (DataRow row in tbl.Rows)
{
Row xlRow = new Row();
foreach (DataColumn col in tbl.Columns)
{
object cellData = row[col];
Cell xlCell = null;
if (cellData != null)
{
xlCell = new Cell(new InlineString(new DocumentFormat.OpenXml.Spreadsheet.Text(cellData.ToString()))) { DataType = CellValues.InlineString };
}
else
{
xlCell = new Cell(new InlineString(new DocumentFormat.OpenXml.Spreadsheet.Text(String.Empty))) { DataType = CellValues.InlineString };
}
xlRow.Append(xlCell);
}
xlSheetData.Append(xlRow);
}
package.WorkbookPart.WorksheetParts.First().Worksheet = new Worksheet(xlSheetData);
package.WorkbookPart.WorksheetParts.First().Worksheet.Save();
// create the worksheet to workbook relation
package.WorkbookPart.Workbook.AppendChild(new Sheets());
package.WorkbookPart.Workbook.GetFirstChild<Sheets>().AppendChild(new Sheet()
{
Id = package.WorkbookPart.GetIdOfPart(package.WorkbookPart.WorksheetParts.First()),
SheetId = 1,
Name = "Sheet1"
});
package.WorkbookPart.Workbook.Save();
}
}
return stream;
}
Shariful, from what I've read (not tried yet), I believe the best method is to set your HTTP Response headers as outlined here.
In short, the key seems to be setting the content-disposition header to "attachment".
e.g.:
Content-Disposition: attachment; filename=<file name.ext>
Sorry that I haven't tested this, but in my searching for something closely related, almost every place I went suggests to use this method in order to force download dialog.

SPWorkflowTask.AlterTask throws "Specified method is not supported"

I'm trying to call AlterTask on a newly created Sharepoint task to add extended properties to my task, and a NotSupportedException is thrown.
What's going on?
The newly created task is actually a SharePoint ListItem. ExtendedProperties is specifically a Workflow Task property.
As per the MSDN documentation:
The content type of the item passed to the task parameter is not derived from the WorkflowTask content type.
This means that Content Type of the SPListItem that represents your new Task must be set to "Workflow Task" before the AlterTask method can be called on it:
Dim selectedTaskList As SPList = web.Lists(taskListName)
' Create a new task item
Dim newTask As SPListItem = selectedTaskList.Items.Add()
' Turn the new task item into a Workflow Task
Dim newTaskContentType As Microsoft.SharePoint.SPContentType = web.AvailableContentTypes("Workflow Task")
newTask("ContentTypeId") = newTaskContentType.Id
' Now the AlterTask method will work. (assume you've alreade declared a hashtable of properties to set)
Microsoft.SharePoint.Workflow.SPWorkflowTask.AlterTask(newTask, myHashTable, True)
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim IntItemID As Integer
Dim siteId As Guid = SPContext.Current.Site.ID
Dim webId As Guid = SPContext.Current.Web.ID
Using objSpSite As New SPSite(siteId)
Using objSpWeb As SPWeb = objSpSite.OpenWeb(webId)
If Not Page.Request.QueryString("ItemID") Is Nothing And Page.Request.QueryString("ItemID") <> "" Then
IntItemID = CInt(Page.Request.QueryString.Item("ItemID").ToString)
Panel1.Visible = False
txtID.Text = IntItemID.ToString
Dim objList As SPList = objSpWeb.Lists("RequestList")
Dim objListItem As SPListItem = objList.Items.GetItemById(IntItemID)
dtPermission.SelectedDate = objListItem("PermissionDate")
dtTimeFrom.SelectedDate = objListItem("PermissionFromTime")
dtTimeTo.SelectedDate = objListItem("PermissionToTime")
cmbType.SelectedValue = objListItem("PermissionType")
'dtCreated.SelectedDate = objListItem("")
Else
IntItemID = 0
txtID.Text = "New"
dtCreated.SelectedDate = Today
txtCreatedBy.Text = objSpWeb.CurrentUser.Name
Dim objServiceContext As SPServiceContext = SPServiceContext.GetContext(objSpSite)
Dim objUserProfileManager As New UserProfileManager(objServiceContext)
Dim objUserProfile As UserProfile
Dim strUserAccount As String
strUserAccount = objSpWeb.CurrentUser.LoginName.Replace("i:0#.w|", "")
If objUserProfileManager.UserExists(strUserAccount) Then
objUserProfile = objUserProfileManager.GetUserProfile(strUserAccount)
Try
txtManager.Text = objUserProfile.GetManager.AccountName
Catch ex As Exception
txtManager.Text = ex.Message
End Try
End If
Panel2.Visible = False
End If
End Using
End Using
End Sub
Protected Sub cmdSubmit_Click(sender As Object, e As EventArgs) Handles cmdSubmit.Click
Dim siteId As Guid = SPContext.Current.Site.ID
Dim webId As Guid = SPContext.Current.Web.ID
Using objSpSite As New SPSite(siteId)
Using objSpWeb As SPWeb = objSpSite.OpenWeb(webId)
objSpWeb.AllowUnsafeUpdates = True
Dim list As SPList = objSpWeb.Lists("RequestList")
Dim item As SPListItem = list.Items.Add()
item("PermissionDate") = dtPermission.SelectedDate
item("PermissionFromTime") = dtTimeFrom.SelectedDate
item("PermissionToTime") = dtTimeTo.SelectedDate
item("PermissionType") = cmbType.SelectedValue
item("PermissionApprover1") = txtManager.Text
item.Update()
list.Update()
objSpWeb.AllowUnsafeUpdates = False
End Using
End Using
End Sub
Protected Sub cmdApprove_Click(sender As Object, e As EventArgs) Handles cmdApprove.Click
Dim siteId As Guid = SPContext.Current.Site.ID
Dim webId As Guid = SPContext.Current.Web.ID
Using objSpSite As New SPSite(siteId)
Using objSpWeb As SPWeb = objSpSite.OpenWeb(webId)
Dim objList As SPList = objSpWeb.Lists("RequestList")
Dim objListItem As SPListItem = objList.Items.GetItemById(CInt(txtID.Text))
Dim objWFTask As SPWorkflowTask = objListItem.Tasks(0)
If objWFTask Is Nothing Then
' no matching task
Return
End If
' alter the task
Dim ht As New Hashtable()
ht("Status") = "Complete"
ht("PercentComplete") = 1.0F
SPWorkflowTask.AlterTask(TryCast(objWFTask, SPListItem), ht, True)
End Using
End Using

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