merge cells with same values in microsoft office interop excel - asp.net

i created a report which exports to excel. it exports just fine. what i want to do now is merge the consecutive cells in a column which have the same values. how do i do this? please help me.
this is code that generates the excel body:
Protected Sub generateExcelBody(ByVal xcelworksheet As Microsoft.Office.Interop.Excel.Worksheet, ByVal recarray As Array, ByVal numofrecords As Integer)
Dim chartrange As Microsoft.Office.Interop.Excel.Range
chartrange = Nothing
chartrange = xcelworksheet.Range("B5", "F5")
chartrange.MergeCells = True
chartrange.HorizontalAlignment = Microsoft.Office.Interop.Excel.XlHAlign.xlHAlignLeft
chartrange.VerticalAlignment = Microsoft.Office.Interop.Excel.XlVAlign.xlVAlignCenter
chartrange = Nothing
chartrange = xcelworksheet.Range("A8", System.Reflection.Missing.Value)
chartrange.FormulaR1C1 = "Record Series : " & hiddenrs.Value
chartrange = Nothing
chartrange = xcelworksheet.Range("A9", System.Reflection.Missing.Value)
chartrange.FormulaR1C1 = "Department : " & hiddendept.Value
chartrange = Nothing
chartrange = xcelworksheet.Range("A10", System.Reflection.Missing.Value)
chartrange.FormulaR1C1 = "Number of Records : " & numofrecords
chartrange = Nothing
chartrange = xcelworksheet.Range("A14", "F14")
chartrange.Resize(numofrecords, 6).Value2 = recarray
chartrange.Resize(numofrecords, 6).Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeLeft).Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium
chartrange.Resize(numofrecords, 6).Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeRight).Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium
chartrange.Resize(numofrecords, 6).Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlInsideHorizontal).Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlThin
chartrange.Resize(numofrecords, 6).Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlInsideVertical).Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlThin
chartrange.Resize(numofrecords, 6).Borders(Microsoft.Office.Interop.Excel.XlBordersIndex.xlEdgeBottom).Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium
chartrange.Resize(numofrecords, 6).WrapText = True
chartrange.Resize(numofrecords, 6).EntireRow.AutoFit()
chartrange.Resize(numofrecords, 6).Font.Size = 10
chartrange.Resize(numofrecords, 6).HorizontalAlignment = Microsoft.Office.Interop.Excel.XlHAlign.xlHAlignCenter
chartrange.Resize(numofrecords, 6).VerticalAlignment = Microsoft.Office.Interop.Excel.XlVAlign.xlVAlignCenter
End Sub

What you want to do is a if - else statement to check if the value of one column is duplicated or not. If yes -> merge the cells. You can either use built in merge cell function in Excel or "hide" the value of the duplicated cell + hide the border between the original and the duplicated cell. Found this while searching.
Sub FormatLikeDates()
Dim d As Date, r As Long, n As Integer, c As Range
For r = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Int(Cells(r, 1)) = Int(Cells(r + 1, 1)) Then
n = n + 1
End If
If Int(Cells(r, 1)) <> Int(Cells(r + 1, 1)) And n > 0 Then
For Each c In Range(Cells(r - n + 1, 1), Cells(r, 1))
c.Font.ColorIndex = 2
c.Interior.ColorIndex = 2
Next c
Range(Cells(r - n, 1), Cells(r, 1)).BorderAround ColorIndex:=3, Weight:=xlThin
n = 0
End If
Next r
End Sub
Source : http://www.ozgrid.com/forum/showthread.php?t=57537

I just received a notification that this question got 1000+ views so I thought I'd post what I did a year ago in solution to this problem. I hope you guys find it useful.
Public Sub mergeRows(ByVal grid As GridView)
For rowIndex As Integer = (grid.Rows.Count - 2) To 0 Step -1
Dim currRow As GridViewRow = grid.Rows(rowIndex)
Dim prevRow As GridViewRow = grid.Rows(rowIndex + 1)
For i As Integer = 0 To (currRow.Cells.Count - 1)
If currRow.Cells(0).Text = prevRow.Cells(i).Text Then
currRow.Cells(0).RowSpan = IIf(prevRow.Cells(0).RowSpan < 2, 2, prevRow.Cells(0).RowSpan + 1)
prevRow.Cells(0).Visible = False
If currRow.Cells(1).Text = prevRow.Cells(1).Text Then
currRow.Cells(1).RowSpan = IIf(prevRow.Cells(1).RowSpan < 2, 2, prevRow.Cells(1).RowSpan + 1)
prevRow.Cells(1).Visible = False
currRow.Cells(2).RowSpan = IIf(prevRow.Cells(1).RowSpan < 2, 2, prevRow.Cells(1).RowSpan + 1)
prevRow.Cells(2).Visible = False
End If
End If
Next
Next
End Sub
Protected Sub Gridview1_PreRender(ByVal sender As Object, ByVal e As EventArgs) Handles Gridview1.PreRender
mergeRows(Gridview1)
End Sub

Related

asp.net dynamic created n number of dropdownlist and take the selected Index Value

I've created a dynamic drop down list and the number of drop down list is equal to total days in the selected month.
I've put all drop down in asp:table but i cant get the data form drop down list
and cant fire the selectedindexchange event.
my code is given below
Protected Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click
Table2.Rows(0).Cells(0).Text = v1_drop_month.SelectedItem.Text
helper.return_month(v1_drop_month.SelectedItem.Text)
i = 1
For row = 0 To 6
For cell = 1 To 7
Dim dd As New DropDownList
Dim label As New Label
If row = 0 And cell = 1 Then
Table2.Rows(row).Cells(cell - 1).BackColor = Drawing.Color.Teal
ElseIf row = 1 Then
Table2.Rows(1).Cells(cell - 1).Font.Size = 14
Table2.Rows(1).Cells(cell - 1).HorizontalAlign = HorizontalAlign.Center
Table2.Rows(1).Cells(cell - 1).ForeColor = Drawing.Color.White
Table2.Rows(1).Cells(cell - 1).BackColor = Drawing.Color.Black
ElseIf row >= 2 Then
If i <= helper.month_num Then
dates = helper.Month_no & "-" & i & "-" & v1_drop_month.SelectedItem.Text.Substring(4, 4)
day = New DateTime(v1_drop_month.SelectedItem.Text.Substring(4, 4), helper.Month_no, i)
If Table2.Rows(1).Cells(cell - 1).Text = day.DayOfWeek.ToString() Then
label.Text = i
label.Font.Size = 20
label.ForeColor = Drawing.Color.Red
Table2.Rows(row).Cells(cell - 1).HorizontalAlign = HorizontalAlign.Right
label.ID = row & "-" & cell
Table2.Rows(row).Cells(cell - 1).Controls.Add(label)
If day.DayOfWeek.ToString() <> "Sunday" Then
label.ForeColor = Drawing.Color.Blue
Table2.Rows(row).Cells(cell - 1).Controls.Add(dd)
dd.ID = "dd" & row & "-" & cell
sql = String.Empty
sql = "select distinct route_number from fr_route where territory='" & v1_drop_territory.SelectedItem.Text & "' and state='" & v1_drop_state.SelectedItem.Text & "' and hq='" & v1_drop_hq.SelectedItem.Text & "'"
helper.dropdown_change(sql, "route_number", dd)
Table2.Rows(row).Cells(cell - 1).BackColor = Drawing.Color.SkyBlue
dd.BackColor = Drawing.Color.Khaki
Table2.Rows(row).Cells(cell - 1).Height = 50
End If
i = i + 1
End If
Else
End If
End If
Next
Next
v1_but_save.Visible = True
v1_but_reset.Visible = True
v1_but_send.Visible = True
End Sub
I've used asp:table for the show dropdown menu
Enable "AutoPostBack=True" for dropdownlist

counting shopping cart 2d Array items in asp-classic

I have a shopping cart that using 2d array Cart(3, 20) to store user shop in a session.
It storing data like this:
Cart(0,0) = Product_ID
Cart(1,0) = Product_Name
Cart(2,0) = Product_Price
Cart(3,0) = Product_Qty
I want to count Items based on product_id ( we have not repetitive product_id)
I found a function here:
Function UniqueEntryCount(SourceRange)
Dim MyDataset
Dim dic
Set dic=Server.CreateObject("Scripting.Dictionary")
MyDataset = SourceRange
For i = 1 To UBound(MyDataset, 2)
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
Next
UniqueEntryCount = dic.Count
Set dic = Nothing
End Function
But one problem is remain, When my Cart is empty, it show me 1
How can solved it?
An unitialized fixed array (Dim a(i, j)) contains i * j empty elements; your
if not dic.Exists(MyDataset(0, i)) then dic.Add MyDataset(0, i), ""
will pick up and count the first empty item. Demonstrated in code:
Dim afCart(3, 4)
Dim dicPID : Set dicPID = countPID00(afCart)
Dim aKeys : aKeys = dicPID.Keys
Dim vKey : vKey = aKeys(0)
WScript.Echo "A", dicPID.Count, TypeName(vKey)
Set dicPID = countPID(afCart)
WScript.Echo "B", dicPID.Count
afCart(0, 0) = "ignored"
afCart(0, 1) = 4711
afCart(0, 2) = 4712
afCart(0, 3) = 4711
' afCart(0, 4) = "not initialized/Empty"
Set dicPID = countPID(afCart)
WScript.Echo "C"
For Each vKey In dicPID.Keys
WScript.Echo "", vKey, "=", dicPID(vKey)
Next
Function countPID00(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim MyDataset : MyDataset = afCart ' waste of ressources
Dim iRow
For iRow = 1 To UBound(MyDataset, 2)
If Not dicRVal.Exists(MyDataset(0, iRow)) Then
dicRVal(MyDataset(0, iRow)) = "" ' loss of info; will pick up Empty item
End If
Next
Set countPID00 = dicRVal
End Function ' countPID00
Function countPID(afCart)
Dim dicRVal : Set dicRVal = CreateObject("Scripting.Dictionary")
Dim iRow
For iRow = 1 To UBound(afCart, 2)
If Not IsEmpty(afCart(0, iRow)) Then
dicRVal(afCart(0, iRow)) = dicRVal(afCart(0, iRow)) + 1
End If
Next
Set countPID = dicRVal
End Function ' countPID
output:
A 1 Empty
B 0
C
4711 = 2
4712 = 1

how can to stop the inserting when the validation is wrong for textbox?

i tried something like this, it insert into the database even thought nric is wrong.
So i want it to stop inserting the data into the database when the nric validation is wrong, however from what i do, the result is it still insert the name in....so where should change to allow it stop inserting until user change the value then can continue insert???
Protected Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
register()
End Sub
Protected Sub nricValidate()
Dim strRegex As String = "^([sS]\d{7}[a-zA-Z])$"
Dim myRegex As Regex = New Regex(strRegex)
Dim strNr As String = txtNRIC.Text
Dim nric As String = txtNRIC.Text
If String.IsNullOrEmpty(txtNRIC.Text) Then
ElseIf myRegex.IsMatch(strNr) Then
Dim nricArray() As Char = nric.ToArray
Dim sum As Integer = 0
Dim num As Integer = 0
Dim result As Integer = 0
Dim numbers As Char
Dim no As String = ""
Dim i As Integer = 0
Do While (i < nricArray.Length)
If (i = 1) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 2)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 2) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 7)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 3) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 6)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 4) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 5)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 5) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 4)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 6) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 3)
nricArray(i) = Convert.ToChar(num)
ElseIf (i = 7) Then
num = 0
numbers = nricArray(i)
no = numbers.ToString
num = Convert.ToInt32(no)
num = (num * 2)
nricArray(i) = Convert.ToChar(num)
End If
i = (i + 1)
Loop
i = 0
Do While (i < nricArray.Length)
If ((i > 0) _
AndAlso (i < 8)) Then
numbers = nricArray(i)
num = Convert.ToInt32(numbers)
sum = (sum + num)
End If
i = (i + 1)
Loop
result = (sum Mod 11)
If (result = 10) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(65)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'A' Nric Error"
End If
ElseIf (result = 9) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(66)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'B' Nric Error"
End If
ElseIf (result = 8) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(67)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'C'Nric Error"
End If
ElseIf (result = 7) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(68)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'D'Nric Error"
End If
ElseIf (result = 6) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(69)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'E'Nric Error"
End If
ElseIf (result = 5) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(70)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'F'Nric Error"
End If
ElseIf (result = 4) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(71)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'G'Nric Error"
End If
ElseIf (result = 3) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(72)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'H'Nric Error"
End If
ElseIf (result = 2) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(73)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'I'Nric Error"
End If
ElseIf (result = 1) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(90)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'Z'Nric Error"
End If
ElseIf (result = 0) Then
If (nricArray(8) = Microsoft.VisualBasic.ChrW(74)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'J'Nric Error"
End If
End If
Return
Else
ResultLabel.Text = "The NRIC is incorrect!"
txtNRIC.Text = String.Empty
txtNRIC.Focus()
End If
End Sub
Protected Sub register()
Dim myConn As New SqlConnection
Dim myCmd As New SqlCommand
myConn.ConnectionString = ConfigurationManager.ConnectionStrings("Company").ConnectionString
Dim cmd As String
cmd = "Insert into Customer values (#fullName, #nric) "
myCmd.CommandText = cmd
myCmd.CommandType = CommandType.Text
nricValidate()
myCmd.Parameters.Add(New SqlParameter("#fullName", txtName.Text))
myCmd.Parameters.Add(New SqlParameter("#nric", txtNRIC.Text))
myCmd.Connection = myConn
myConn.Open()
myCmd.ExecuteNonQuery()
myCmd.Dispose()
myConn.Dispose()
End Sub
That big loop is entirely unnecessary. There's so much to fix here that I'll do a big rewrite. I turned 216 lines into 41, no problem. It could most likely be made much better, too.
Protected Sub btnSubmit_Click(sender As Object, e As EventArgs) Handles btnSubmit.Click
If nricValidate() Then
Using myConn As New SqlConnection(ConfigurationManager.ConnectionStrings("Company").ConnectionString),
myCmd As SqlCommand = myConn.CreateCommand()
myCmd.CommandText = "INSERT INTO Customer VALUES(#fullName, #nric)"
myCmd.CommandType = CommandType.Text
myCmd.Parameters.Add(New SqlParameter("#fullName", txtName.Text))
myCmd.Parameters.Add(New SqlParameter("#nric", txtNRIC.Text))
myConn.Open()
myCmd.ExecuteNonQuery()
End Using
End If
End Sub
Protected Function nricValidate() As Boolean
Dim myRegex As New Regex("^([sS]\d{7}[a-zA-Z])$")
If Not String.IsNullOrEmpty(txtNRIC.Text) AndAlso myRegex.IsMatch(txtNRIC.Text) Then
Dim nricArray(txtNRIC.Text.Length - 1) As Integer
Dim sum As Integer = 0
For i As Integer = 1 To 7
sum += Integer.Parse(txtNRIC.Text.Substring(i, 1)) * If(i = 1, 2, 9 - i)
Next
If nricArray(8) <> 75 - sum Mod 11 Then
txtNRIC.Focus()
ResultLabel.Text = "The last value should be " & (75 - sum Mod 11).ToString() & ": NRIC Error"
Return False
End If
Return True
Else
ResultLabel.Text = "The NRIC is incorrect!"
txtNRIC.Text = String.Empty
txtNRIC.Focus()
End If
Return False
End Function
Your actual answer is - you need to turn nricValidate into a Function, return a success value, and check for success before inserting into the database. But the rest of your code could be heavily optimized too, as you can see.
I do apologize in advance, but that is the worst code I've ever seen in my entire life. Please read up on how to program in general.
change your nricValidate to return true if validation pass
Protected Function nricValidate() As Boolean
'Return True if validation pass
End Function
then you can validate and proceed
If nricValidate() Then
Dim myConn As New SqlConnection
Dim myCmd As New SqlCommand
myConn.ConnectionString = ConfigurationManager.ConnectionStrings("Company").ConnectionString
Dim cmd As String
cmd = "Insert into Customer values (#fullName, #nric) "
myCmd.CommandText = cmd
myCmd.CommandType = CommandType.Text
myCmd.Parameters.Add(New SqlParameter("#fullName", txtName.Text))
myCmd.Parameters.Add(New SqlParameter("#nric", txtNRIC.Text))
myCmd.Connection = myConn
myConn.Open()
myCmd.ExecuteNonQuery()
myCmd.Dispose()
myConn.Dispose()
End If
another way is if ResultLabel has text on validation fail check that before execute database operation.
you have to make a return false on every validation fail. like this:
If (nricArray(8) = Microsoft.VisualBasic.ChrW(65)) Then
Else
txtNRIC.Focus()
ResultLabel.Text = "last alphabet should be 'A' Nric Error"
return False
End If
...
return True 'at the end of the function
dont forget to change the sub to function of boolean return type.
Protected function nricValidate() as Boolean
and then inside you register sub
replace nricValidate() with if not nricValidate() then exit sub and make it bfore any declaration so no need to dispose anything ...
Since you are posting the error to the result label, you could use this object within the button submit to detect an error:
If (String.IsNullOrEmpty(ResultLabel.Text)) Then
' valid,continue
End IF

Session disappears unexpectedly

The site is a buy/sell site and the page the code comes from is the "add product" page.
The problem is that the session("change") becomes nothing by some reason, I can't find any errors. The payment.aspx have a button that sends me back to the page with a session("change").
The reason I see the problem is that when I try to edit something the category gets restetted to the first in the list. and when I debug I see that the session is nothing, though it should be something
Heres the code:
Protected Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles BtnSubmit.Click
If Not stats > 0 Then
If Session("change") IsNot Nothing Then
Dim dc As New DataClassesDataContext
Dim getP = From prod In dc.Products _
Where prod.ProductID = CInt(Session("change")) _
Select prod
If getP.Any Then
If rdbSell.Checked = True Then
getP.FirstOrDefault.BuySell = True
Else
getP.FirstOrDefault.BuySell = False
End If
If ddlSubSubcat.SelectedValue IsNot String.Empty Then
getP.FirstOrDefault.CategoryID = CInt(ddlSubSubcat.SelectedValue)
Else
getP.FirstOrDefault.CategoryID = CInt(ddlSubCat.SelectedValue)
End If
getP.FirstOrDefault.Content = txtContent.Text.Replace(Environment.NewLine, "<br />")
getP.FirstOrDefault.CountyID = CInt(ddlCounty.SelectedValue)
getP.FirstOrDefault.E_mail = txtEmail.Text
getP.FirstOrDefault.Date = DateTime.Now
getP.FirstOrDefault.Active = 0
getP.FirstOrDefault.Alias = txtAlias.Text.Replace("'", "''")
getP.FirstOrDefault.ShowEmail = 0
Dim PreID As Integer = getP.FirstOrDefault.ProductID
If chkShowEmail.Checked = True Then
getP.FirstOrDefault.ShowEmail = 1
Else
getP.FirstOrDefault.ShowEmail = 0
End If
If chkShowPhone.Checked = True Then
getP.FirstOrDefault.ShowPhone = 1
Else
getP.FirstOrDefault.ShowPhone = 0
End If
getP.FirstOrDefault.Headline = txtHeadline.Text
getP.FirstOrDefault.Password = txtPassword.Text
getP.FirstOrDefault.Phone = txtPhone.Text
getP.FirstOrDefault.Price = txtPrice.Text
If chkUnknown.Checked = True Then
getP.FirstOrDefault.YearModel = String.Empty
Else
getP.FirstOrDefault.YearModel = ddlYear.SelectedValue
End If
For Each item In libPictures.Items
Dim i As String = item.ToString
Dim imagecheck = From img In dc.Pictures _
Where img.Name = i And img.ProductID = CInt(Session("change")) _
Select img
If imagecheck.Any Then
Else
Dim img As New Picture
img.Name = item.ToString
img.ProductID = CInt(Session("change"))
dc.Pictures.InsertOnSubmit(img)
dc.SubmitChanges()
End If
Next
dc.SubmitChanges()
Session.Remove("change")
Response.Redirect("~/precheck.aspx?id=" + PreID.ToString)
End If
Else
Dim dc As New DataClassesDataContext
Dim prod As New Product
If rdbSell.Checked = True Then
prod.BuySell = True
Else
prod.BuySell = False
End If
If ddlSubSubcat.DataValueField IsNot String.Empty Then
prod.CategoryID = CInt(ddlSubSubcat.SelectedValue)
Else
prod.CategoryID = CInt(ddlSubCat.SelectedValue)
End If
prod.Content = txtContent.Text.Replace(Environment.NewLine, "<br />")
prod.CountyID = CInt(ddlCounty.SelectedValue)
prod.E_mail = txtEmail.Text
prod.Date = DateTime.Now
prod.Active = 0
prod.Alias = txtAlias.Text.Replace("'", "''")
prod.ShowEmail = 0
If chkShowEmail.Checked = True Then
prod.ShowEmail = 1
Else
prod.ShowEmail = 0
End If
If chkShowPhone.Checked = True Then
prod.ShowPhone = 1
Else
prod.ShowPhone = 0
End If
prod.Headline = txtHeadline.Text
prod.Password = txtPassword.Text
prod.Phone = txtPhone.Text
prod.Price = txtPrice.Text
If chkUnknown.Checked = True Then
prod.YearModel = String.Empty
Else
prod.YearModel = ddlYear.SelectedValue
End If
dc.Products.InsertOnSubmit(prod)
dc.SubmitChanges()
Dim PreID As Integer = prod.ProductID
For Each item In libPictures.Items
Dim img As New Picture
img.Name = item.ToString
img.ProductID = prod.ProductID
dc.Pictures.InsertOnSubmit(img)
dc.SubmitChanges()
Next
Session.Remove("change")
Response.Redirect("./precheck.aspx?id=" + PreID.ToString, False)
End If
End If
stats = 0
'Catch ex As Exception
'End Try
End Sub
It depends upon how the application is managing session state. If your session state is managed InProc then if the application pool is recycled then all your session information will be lost. If that is happening then it could be a good option to store session state in SQL Server which will persist between app pool recycling.
More info:
ASP.NET Session State Overview
ASP.NET State Management Recommendations

Adaptive a vba excel function to be recursive

Im having trouble converting a working solution that takes a directory folder as an input and outputs the filenames and other file attributes of files container in the folder into an excel spreadsheet to a recursive solution that also outputs the files contained in subfolders. I would greatly appreciate any help!
Sub GetFileList()
Dim strFolder As String
Dim varFileList As Variant
Dim FSO As Object, myFile As Object
Dim myResults As Variant
Dim l As Long
' Get the directory from the user
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
'user cancelled
strFolder = .SelectedItems(1)
End With
' Get a list of all the files in this directory. ' Note that this isn't recursive... although it could be...
varFileList = fcnGetFileList(strFolder)
If Not IsArray(varFileList) Then
MsgBox "No files found.", vbInformation
Exit Sub
End If
' Now let's get all the details for these files ' and place them into an array so it's quick to dump to XL.
ReDim myResults(0 To UBound(varFileList) + 1, 0 To 5)
' place make some headers in the array
myResults(0, 0) = "Filename"
myResults(0, 1) = "Size"
myResults(0, 2) = "Created"
myResults(0, 3) = "Modified"
myResults(0, 4) = "Accessed"
myResults(0, 5) = "Full path"
Set FSO = CreateObject("Scripting.FileSystemObject")
' Loop through our files
For l = 0 To UBound(varFileList)
Set myFile = FSO.GetFile(CStr(varFileList(l)))
myResults(l + 1, 0) = CStr(varFileList(l))
myResults(l + 1, 1) = myFile.Size
myResults(l + 1, 2) = myFile.DateCreated
myResults(l + 1, 3) = myFile.DateLastModified
myResults(l + 1, 4) = myFile.DateLastAccessed
myResults(l + 1, 5) = myFile.Path
Next l
' Dump these to a worksheet
fcnDumpToWorksheet myResults
'tidy up
Set myFile = Nothing
Set FSO = Nothing
End Sub
Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant ' Returns a one dimensional array with filenames ' Otherwise returns False
Dim f As String
Dim i As Integer
Dim FileList() As String
If strFilter = "" Then strFilter = "."
Select Case Right$(strPath, 1)
Case "\", "/"
strPath = Left$(strPath, Len(strPath) - 1)
End Select
ReDim Preserve FileList(0)
f = Dir$(strPath & "\" & strFilter)
Do While Len(f) > 0
ReDim Preserve FileList(i) As String
FileList(i) = f
i = i + 1
f = Dir$()
Loop
If FileList(0) <> Empty Then
fcnGetFileList = FileList
Else
fcnGetFileList = False
End If
End Function
Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)
Dim iSheetsInNew As Integer
Dim sh As Worksheet, wb As Workbook
Dim myColumnHeaders() As String
Dim l As Long, NoOfRows As Long
If mySh Is Nothing Then
'make a workbook if we didn't get a worksheet
iSheetsInNew = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iSheetsInNew
Set sh = wb.Sheets(1)
Else
Set mySh = sh
End If
With sh
Range(.Cells(1, 1), .Cells(UBound(varData, 1) + 1, UBound(varData, 2) + 1)) = varData
.UsedRange.Columns.AutoFit
End With
Set sh = Nothing
Set wb = Nothing
End Sub
I've rewritten the code to pass your results array and a counter to the recursive function. The function fills the array and calls itself with any subfolders
Sub GetFileList()
Dim strFolder As String
Dim FSO As Object
Dim fsoFolder As Object
Dim myResults As Variant
Dim lCount As Long
Set FSO = CreateObject("Scripting.FileSystemObject")
' Get the directory from the user
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
'user cancelled
strFolder = .SelectedItems(1)
End With
Set fsoFolder = FSO.GetFolder(strFolder)
'the variable dimension has to be the second one
ReDim myResults(0 To 5, 0 To 0)
' place make some headers in the array
myResults(0, 0) = "Filename"
myResults(1, 0) = "Size"
myResults(2, 0) = "Created"
myResults(3, 0) = "Modified"
myResults(4, 0) = "Accessed"
myResults(5, 0) = "Full path"
'Send the folder to the recursive function
FillFileList fsoFolder, myResults, lCount
' Dump these to a worksheet
fcnDumpToWorksheet myResults
'tidy up
Set FSO = Nothing
End Sub
Private Sub FillFileList(fsoFolder As Object, ByRef myResults As Variant, ByRef lCount As Long, Optional strFilter As String)
Dim i As Integer
Dim fsoFile As Object
Dim fsoSubFolder As Object
Dim fsoSubFolders As Object
'load the array with all the files
For Each fsoFile In fsoFolder.Files
lCount = lCount + 1
ReDim Preserve myResults(0 To 5, 0 To lCount)
myResults(0, lCount) = fsoFile.Name
myResults(1, lCount) = fsoFile.Size
myResults(2, lCount) = fsoFile.DateCreated
myResults(3, lCount) = fsoFile.DateLastModified
myResults(4, lCount) = fsoFile.DateLastAccessed
myResults(5, lCount) = fsoFile.Path
Next fsoFile
'recursively call this function with any subfolders
Set fsoSubFolders = fsoFolder.SubFolders
For Each fsoSubFolder In fsoSubFolders
FillFileList fsoSubFolder, myResults, lCount
Next fsoSubFolder
End Sub
Private Sub fcnDumpToWorksheet(varData As Variant, Optional mySh As Worksheet)
Dim iSheetsInNew As Integer
Dim sh As Worksheet, wb As Workbook
Dim myColumnHeaders() As String
Dim l As Long, NoOfRows As Long
If mySh Is Nothing Then
'make a workbook if we didn't get a worksheet
iSheetsInNew = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set wb = Application.Workbooks.Add
Application.SheetsInNewWorkbook = iSheetsInNew
Set sh = wb.Sheets(1)
Else
Set mySh = sh
End If
'since we switched the array dimensions, have to transpose
With sh
Range(.Cells(1, 1), .Cells(UBound(varData, 2) + 1, UBound(varData, 1) + 1)) = _
Application.WorksheetFunction.Transpose(varData)
.UsedRange.Columns.AutoFit
End With
Set sh = Nothing
Set wb = Nothing
End Sub

Resources