VB6 Run time error 424 - vb6

I am getting error 424 on this line, can anyone help me please.
lblprvbal.Text = Val(NewItem.SubItems(11))
Private Sub cmdShow_Click()
'lblTotPur/lblTotPayRet/lblBalance
Dim strShow, mSlNo
Dim rsShow As New ADODB.Recordset
Dim NewItem As Variant
If Trim(txtCustomer.Text) = "" Then
MsgBox "Please select customer to proceed...", vbCritical, POPUP_COMP
Exit Sub
End If
Dim recCnt
pgrPartyLedger.Min = 0
recCnt = 0
'VOUCHMST_P//VNO,DATED,VTYPE,REMARKS,byUser CASH PURCHASE RETURN
strShow = "select Count(*) as mCnt from VOUCHMST A,VOUCHDAT B, Prevbal C "
strShow = strShow & " where A.VNO=B.VNO and B.IDNO=C.obd and (A.REMARKS='CASH SALE RETURN' OR A.REMARKS='CREDIT SALE RETURN' OR A.REMARKS='CREDIT SALE' OR A.REMARKS='CASH SALE' OR A.REMARKS='RECEIPT' OR A.REMARKS='CREDIT NOTE') "
strShow = strShow & " and A.DATED between #" & Format(dtFrom.Value, "MM/dd/yyyy") & "# "
strShow = strShow & " and #" & Format(dtTo.Value, "MM/dd/yyyy") & "# "
strShow = strShow & " and B.IDNO = '" & Trim(txtCustomerId.Text) & "' "
'strShow = strShow & " order by A.ID,A.DATED,A.VNO"
rsShow.Open strShow, cn
recCnt = rsShow("mCnt")
rsShow.Close
pgrPartyLedger.Max = recCnt + 1
'VOUCHMST_P//VNO,DATED,VTYPE,REMARKS,byUser
strShow = "select A.Id,A.cmnt,A.ADV,A.VNO,A.DATED,B.IDNO,B.IDNAME,B.AMOUNT,B.DR_CR,B.VNARRATION,A.REMARKS,B.CQ_TYPE, B.BANKNAME, B.BANKBRANCH, B.CQ_NO, C.amnt from VOUCHMST A,VOUCHDAT B, Prevbal C "
strShow = strShow & " where A.VNO=B.VNO and B.IDNO=C.obd and (A.REMARKS='CASH SALE RETURN' OR A.REMARKS='CREDIT SALE RETURN' OR A.REMARKS='CREDIT SALE' OR A.REMARKS='CASH SALE' OR A.REMARKS='RECEIPT' OR A.REMARKS='CREDIT NOTE') "
strShow = strShow & " and A.DATED between #" & Format(dtFrom.Value, "MM/dd/yyyy") & "# "
strShow = strShow & " and #" & Format(dtTo.Value, "MM/dd/yyyy") & "# "
strShow = strShow & " and B.IDNO = '" & Trim(txtCustomerId.Text) & "' "
strShow = strShow & " order by A.ID,A.DATED,A.VNO"
rsShow.Open strShow, cn
Dim mPur, mPayRet, mAnyAdv, mTempVNO
mPur = 0
mPayRet = 0
mAnyAdv = 0
mSlNo = 1
ShowPaymentHeader
Do While Not rsShow.EOF
mTempVNO = rsShow("VNO")
Set NewItem = listViewPayment.ListItems.Add(, "C" & mSlNo, Format(rsShow("DATED"), "dd/MM/yyyy"))
NewItem.SubItems(1) = mTempVNO
NewItem.SubItems(2) = IIf(IsNull(rsShow("IDNAME")), "", CommaFilterText(rsShow("IDNAME"), 1))
NewItem.SubItems(11) = rsShow("amnt")
If Trim(rsShow("REMARKS")) = "CASH SALE" Then
NewItem.SubItems(3) = FormatTakaPaisa(rsShow("AMOUNT"))
NewItem.SubItems(4) = FormatTakaPaisa(rsShow("AMOUNT"))
ElseIf Trim(rsShow("REMARKS")) = "CREDIT SALE" Then
mAnyAdv = ShowPartialAdvance(rsShow("VNO"))
NewItem.SubItems(3) = FormatTakaPaisa(rsShow("AMOUNT") + Val(mAnyAdv))
If Val(mAnyAdv) > 0 Then
NewItem.SubItems(4) = FormatTakaPaisa(mAnyAdv)
Else
NewItem.SubItems(4) = ""
End If
Else
NewItem.SubItems(3) = ""
NewItem.SubItems(4) = FormatTakaPaisa(rsShow("AMOUNT"))
NewItem.SubItems(7) = rsShow("CQ_TYPE")
NewItem.SubItems(8) = rsShow("BANKNAME")
NewItem.SubItems(9) = rsShow("BANKBRANCH")
NewItem.SubItems(10) = rsShow("CQ_NO")
NewItem.SubItems(13) = "" & rsShow("cmnt")
End If
NewItem.SubItems(6) = rsShow("IDNO")
mPur = mPur + Val(NewItem.SubItems(3))
mPayRet = mPayRet + Val(NewItem.SubItems(4))
NewItem.SubItems(5) = rsShow("REMARKS")
NewItem.SubItems(12) = GetVoucherRefNo(mTempVNO)
pgrPartyLedger.Value = mSlNo
mSlNo = mSlNo + 1
rsShow.MoveNext
Loop
rsShow.Close
lblprvbal.Text = Val(NewItem.SubItems(11))
lblTotPur.Caption = FormatTakaPaisa(mPur) + Val(lblprvbal.Text)
lblTotPayRet.Caption = FormatTakaPaisa(mPayRet)
lblBalance.Caption = FormatTakaPaisa(mPur - mPayRet) + Val(lblprvbal.Text)
pgrPartyLedger.Value = 0
End Sub

Looks like lblprvbal isn't an object. Meaning, you don't have a TextBox called lblprvbal in your form, even if you think you do. Maybe because its real name is lblPrvBal? That would be consistent with your other object names. As a side note, you probably don't want to start a TextBox with lbl, which suggests it's a label.

Try below. value in the sub item is null and hence the error.
If IsDBNull(NewItem.SubItems(11)) Then
lblprvbal.Text = ""
Else
lblprvbal.Text = Val(NewItem.SubItems(11))
End If

Check if not NewItem is Nothing.

Related

Vbscript how to find the first char from the end in text

I have problem with find the first char from the end in text.
For example, find space(" ") or new line(vbCrLf) on "Father go home" i get the index of first space from the end and on "Father go home/ntomorrow" i get the index of /n.
my code:
Function checkTextFunction( i_valueCheck)
Dim whereSpace
Dim WhereNewLine
Dim indexOFirstSpaceFromTheEnd
If Right(i_valueCheck,1) = " " Or Right(i_valueCheck,1) = vbCrLf Then
indexOFirstSpaceFromTheEnd = -1
Else
whereSpace = InStrRev(i_valueCheck, " ", -1,0)
WhereNewLine = InStrRev(i_valueCheck, vbCrLf, -1,0)
If whereSpace < WhereNewLine Then
indexOFirstSpaceFromTheEnd = whereSpace
Else
indexOFirstSpaceFromTheEnd = WhereNewLine
End If
End IF
WriteLogFileLine "indexOFirstSpaceFromTheEnd: " & indexOFirstSpaceFromTheEnd & " Right(i_valueCheck,1): " & Right(i_valueCheck,1) & vbCrLf & vbCrLf
checkTextFunction = indexOFirstSpaceFromTheEnd
End Function
but i don't find the first occurrence with the lines
whereSpace = InStrRev(i_valueCheck, " ", 1)
WhereNewLine = InStrRev(i_valueCheck, vbCrLf,1)
i get always 0.
Someone have idea?
******* I edit my question !!!!.
Thanks,
Tal
vbCrLf is actually 2 characters, so you want to specify Right(i_valueCheck, 2) = vbCrLf
If the character is not in the string, then InStrRev will return 0.. which would mean it is always the first occurrence. The second If statement should be a little more explicit in terms of the values of the variables.
Since you're not initializing indexOFirstSpaceFromTheEnd... If there are no vbCrLf or " " characters- it will remain empty. Therefore you should add a check in order to return a value every time... regardless of the string. I picked one million arbitrarily.
Function checkTextFunction(ByRef i_valueCheck)
Dim whereSpace
Dim whereNewLine
Dim indexOFirstSpaceFromTheEnd
If Right(i_valueCheck,1) = " " Or Right(i_valueCheck,2) = vbCrLf Then
indexOFirstSpaceFromTheEnd = -1
Else
whereSpace = InStrRev(i_valueCheck, " ", -1, 0)
whereNewLine = InStrRev(i_valueCheck, vbCrLf, -1, 0)
If whereSpace > 0 And (whereSpace < whereNewLine Or whereNewLine = 0) Then
indexOFirstSpaceFromTheEnd = whereSpace
ElseIf whereNewLine > 0 And (whereNewLine < whereSpace Or whereSpace = 0) Then
indexOFirstSpaceFromTheEnd = whereNewLine
End If
End If
If indexOFirstSpaceFromTheEnd = vbEmpty Then indexOFirstSpaceFromTheEnd = 1000000
WriteLogFileLine "indexOFirstSpaceFromTheEnd: " & _
indexOFirstSpaceFromTheEnd & _
" Right(i_valueCheck,1): " & _
Right(i_valueCheck,1) & vbCrLf & vbCrLf
checkTextFunction = indexOFirstSpaceFromTheEnd
End Function
This should help you get started... realistically- if you want to find the first occurrence of vbCrLf or " " then you're going to have to operate a While loop in order to keep checking (with InStrRev) that the index is actually the last occurrence.
For example: with the code above... look at the output of checkTextFunction(Space(2) & "test")
The final answer: if the last char in "i_valueCheck" is not space or vbCrLf it's find the first case(space or vbCrLf) from the end of "i_valueCheck".
Function checkTextFunction( i_valueCheck)
Dim whereSpace
Dim whereNewLine
Dim indexOFirstSpaceFromTheEnd
If Right(i_valueCheck,1) = " " Or Right(i_valueCheck,2) = vbCrLf Then
indexOFirstSpaceFromTheEnd = -1
Else
whereSpace = InStrRev(i_valueCheck, " ", -1, 0)
whereNewLine = InStrRev(i_valueCheck, vbCrLf, -1, 0)
If whereSpace > 0 And (whereSpace > whereNewLine Or whereNewLine = 0) Then
indexOFirstSpaceFromTheEnd = whereSpace
ElseIf whereNewLine > 0 And (whereNewLine > whereSpace Or whereSpace = 0) Then
indexOFirstSpaceFromTheEnd = whereNewLine
Else
indexOFirstSpaceFromTheEnd = -1
End If
End If
checkTextFunction = indexOFirstSpaceFromTheEnd End Function

I am getting error Microsoft VBScript runtime error '800a0009' Subscript out of range: 'j'

I am trying to insert data in classic asp but getting following error:
Microsoft VBScript runtime error '800a0009' Subscript out of range: 'j'
For reference I am attaching my code. I am new to classic asp
IF Len(FixString(Request.Form("txtModelTypeID"))) >= 1 AND cboSlab = "SlabCombineSeries" Then
arrModelTypeID = split(trim(Request.Form("txtModelTypeID")),",")
arrModelID = split(trim(Request.Form("txtModelID")),",")
arrSlab = split(trim(Request.Form("txtSlab")),",")
arrAmount = split(trim(Request.Form("txtAmount")),",")
arrSF = split(trim(Request.Form("txtSF")),",")
arrNonSF = split(trim(Request.Form("txtNonSF")),",")
arrPMY = split(trim(Request.Form("txtPMY")),",")
arrCMY = split(trim(Request.Form("txtCMY")),",")
arrPIY = split(trim(Request.Form("txtPIY")),",")
arrCIY = split(trim(Request.Form("txtCIY")),",")
arrTradeIn = split(trim(Request.Form("txtTradeIn")),",")
arrLoyalty = split(trim(Request.Form("txtLoyalty")),",")
arrSpecial1 = split(trim(Request.Form("txtSpecial1")),",")
arrSpecial2 = split(trim(Request.Form("txtSpecial2")),",")
arrSpecial3 = split(trim(Request.Form("txtSpecial3")),",")
arrkeydiscount = split(trim(Request.Form("txtkeydiscount")),",")
arrsme = split(trim(Request.Form("txtsme")),",")
if ubound(arrModelTypeID) = 0 Then
elseif ubound(arrModelTypeID) > 0 Then
FOR j = 0 to ubound(arrModelTypeID)
if NOT ISNumeric(TRIM(arrSlab(j))) Then Slab = 0 else Slab = TRIM(arrSlab(j)) end if
if NOT ISNumeric(TRIM(arrAmount(j))) Then Amount = 0 else Amount = TRIM(arrAmount(j)) end if
if NOT ISNumeric(TRIM(arrSF(j))) Then SF = 0 else SF = TRIM(arrSF(j)) end if
if NOT ISNumeric(TRIM(arrNonSF(j))) Then NonSF = 0 else NonSF = TRIM(arrNonSF(j)) end if
if NOT ISNumeric(TRIM(arrPMY(j))) Then PMY = 0 else PMY = TRIM(arrPMY(j)) end if
if NOT ISNumeric(TRIM(arrCMY(j))) Then CMY = 0 else CMY = TRIM(arrCMY(j)) end if
if NOT ISNumeric(TRIM(arrPIY(j))) Then PIY = 0 else PIY = TRIM(arrPIY(j)) end if
if NOT ISNumeric(TRIM(arrCIY(j))) Then CIY = 0 else CIY = TRIM(arrCIY(j)) end if
if NOT ISNumeric(TRIM(arrTradeIn(j))) Then TradeIn = 0 else TradeIn = TRIM(arrTradeIn(j)) end if
if NOT ISNumeric(TRIM(arrLoyalty(j))) Then Loyalty = 0 else Loyalty = TRIM(arrLoyalty(j)) end if
if NOT ISNumeric(TRIM(arrSpecial1(j))) Then Special1 = 0 else Special1 = TRIM(arrSpecial1(j)) end if
if NOT ISNumeric(TRIM(arrSpecial2(j))) Then Special2 = 0 else Special2 = TRIM(arrSpecial2(j)) end if
if NOT ISNumeric(TRIM(arrSpecial3(j))) Then Special3 = 0 else Special3 = TRIM(arrSpecial3(j)) end if
if NOT ISNumeric(TRIM(arrkeydiscount (j))) Then Key = 0 else Key = TRIM(arrkeydiscount(j)) end if
if NOT ISNumeric(TRIM(arrsme (j))) Then Sme = 0 else Sme = TRIM(arrsme(j)) end if
SQL = SQL & "INSERT INTO demo_Item ( " &_
" iSPCMasterID, iModelID, vModelName, vModelCode, iSlab, mAmount, " &_
" mSF, mNonSF, mPMY, mCMY, mPIY, mCIY, mTradeIn, mLoyalty, " &_
" mSpecial1, mSpecial2,key_acc,sme, mSpecial3, dCreateDate, iSeq) " &_
" SELECT #NewID, i_modelid, vch_modelname, modelcode, " &_
" " & Slab & ", " &_
" " & Amount & ", " &_
" " & SF & ", " &_
" " & NonSF & ", " &_
" " & PMY & ", " &_
" " & CMY & ", " &_
" " & PIY & ", " &_
" " & CIY & ", " &_
" " & TradeIn & ", " &_
" " & Loyalty & ", " &_
" " & Special1 & ", " &_
" " & Special2 & ", " &_
" " & Key & ", " &_
" " & Sme & ", " &_
" " & Special3 & " , getdate(), " & j + 1 &_
" FROM ltr_or_models WHERE CAST(i_modeltypeid as varchar(20)) = '" & trim(arrModelTypeID(j)) & "' "
next
end if
You are attempting to loop through multiple arrays simultaneously using a single counter. I.E. You are setting the end of the j counter using the upper level of the arrModelTypeID array and then expecting the remaining and separate arrays (arrSlab, arrAmount etc.) to use the same counter.
Assuming the data in all your newly created arrays are ordered identically to each other. Try checking each array record for a value before setting its assigned variable.
E.G. CHANGE
if NOT ISNumeric(TRIM(arrSlab(j))) Then Slab = 0 else Slab = TRIM(arrSlab(j)) end if
TO
If arrSlab(j) <> "" Then
if NOT ISNumeric(TRIM(arrSlab(j))) Then Slab = 0 else Slab = TRIM(arrSlab(j)) end if
End If

ComboBox onchange for VB Script

I am a newbie when it comes to VB Script and I am trying to make a Combo box with an onchange event.
Here is the code that i have so far:
' Report Version
If FieldID = 36 Then
If IsLIXIJob Then
'first get the field id of the fields you want to hide or display
SQLQuery = "SELECT FieldID, FieldName FROM Fields WITH (NOLOCK) " & _
" WHERE [Table] = 'Valuations' AND " & _
" FieldName IN ('RiskTenderPriceDisplay', 'RiskProgressPaymentScheduleDisplay')"
Set LIXITBEFields = dbConn.Execute(SQLQuery)
TBEFieldsOn = ""
TBEFieldsOff = ""
If Not LIXITBEFields.EOF Then
Do While Not LIXITBEFields.EoF
TBEFieldsOn = TBEFieldsOn & "if (IsDefined ('StandardField_" & LIXITBEFields ("FieldID") & "')) $('StandardField_" & LIXITBEFields ("FieldID") & "').style.display = ''; " & vbCrLf
TBEFieldsOff = TBEFieldsOff & "if (IsDefined ('StandardField_" & LIXITBEFields ("FieldID") & "')) $('StandardField_" & LIXITBEFields ("FieldID") & "').style.display = 'none'; " & vbCrLf
LIXITBEFields.MoveNext ()
Loop
End If
LIXITBEFields.Close ()
Set LIXITBEFields = Nothing
End If
Select Case Output
Case 0
RunAtEnd = "AllFields(); " & TBEFieldsOff
Case 1
RunAtEnd = "StandardMode(); " & TBEFieldsOff
Case 2
RunAtEnd = "StrataMode();" & TBEFieldsOff
Case 3
RunAtEnd = "TBEMode();" & TBEFieldsOn
Case 4
RunAtEnd = "TBEUnitMode();" & TBEFieldsOn
Case 5
RunAtEnd = "RenoMode(); " & TBEFieldsOff
Case 6
RunAtEnd = "RenoUnitMode(); " & TBEFieldsOff
Case 7
RunAtEnd = "VacantLandMode();" & TBEFieldsOff
End Select
%>
<select name="ReportList" id="ReportList" onchange="ReportList_SelectedIndexChanged()">
<option value="All Fields">All Fields</option>
<option value="Existing Building">Existing Building</option>
<option value="xisting Building - Strata">Existing Building - Strata</option>
<option value="To Be Erected">To Be Erected</option>
<option value="To Be Erected - Strata">To Be Erected - Strata</option>
<option value="Extension & Renovation">Extension & Renovation</option>
<option value="Extension & Renovation - Strata">Extension & Renovation - Strata</option>
<option value="Vacant Land">Vacant Land</option>
</select>
<%
End If
I tried making a Sub statement enclosing the Select Case but it didn't work.
I also made a Private Sub outside the If statement and called in on the onchange for the comboBox:
Private Sub ReportList_SelectedIndexChanged()
Dim selectedInd
selectedInd = ReportList.SelectedIndex
Dim selectedIt
selectedIt = ReportList.SelectedItem.Text
If selectedIt = "All Fields" Then
RunAtEnd = "AllFields(); " & TBEFieldsOff
End If
If selectedIt = "Existing Building" Then
RunAtEnd = "StandardMode(); " & TBEFieldsOff
End If
If selectedIt = "Existing Building - Strata" Then
RunAtEnd = "StrataMode();" & TBEFieldsOff
End If
If selectedIt = "To Be Erected" Then
RunAtEnd = "TBEMode();" & TBEFieldsOn
End If
If selectedIt = "To Be Erected - Strata" Then
RunAtEnd = "TBEUnitMode();" & TBEFieldsOn
End If
If selectedIt = "Extension & Renovation" Then
RunAtEnd = "RenoMode(); " & TBEFieldsOff
End If
If selectedIt = "Extension & Renovation - Strata" Then
RunAtEnd = "RenoUnitMode(); " & TBEFieldsOff
End If
If selectedIt = "Vacant Land" Then
RunAtEnd = "VacantLandMode();" & TBEFieldsOff
End If
End Sub
I'm really stuck at this bit. Anyway I can make this work?

VBScript output as Excel worksheet not working

I've got a page that will either display information in an HTML table or output that same info as an excel file.
The HTML view is working fine, but the excel portion fails with : (500 - Internal server error. There is a problem with the resource you are looking for, and it cannot be displayed.)
Ideally, if its possible to separate the excel portion of the code I'd rather have that as the final product, but I need to get it working first. I'd appreciate any ideas.
<%# Language=VBScript %>
<% Session("CurrentPageTitle") = "Test Transaction Summary" %>
<%
Response.Buffer = TRUE
if Request.Form("present") = "xls" then
set objXL = CreateObject("Excel.Application")
Set objWB = objXL.WorkBooks.Open("C:\Inetpub\wwwroot\temp\xl.xlsx")
Set objWS = objXL.ActiveWorkBook.WorkSheets("Sheet1")
numRow = 9
end if
if Request.Form("present") <> "xls" then
%>
<!--#include file="../common/header.inc"-->
<%
end if
varState = Request.QueryString("state")
varCustomerIdentifier = Request.Form("Customer")
CustomerArray = Split(varCustomerIdentifier,",")
varCustomer = CustomerArray(0)
varSub = CustomerArray(1)
varCity = CustomerArray(2)
if Request.Form("Summary") = "user" and varState <> "u" then
'Should not be here, form navigation glitch - go to GetUserParam.asp
location.href="GetUserParam.asp?f=" & varCustomerIdentifier & "&t=user"
else
if varState = "u" then
varYesterday = Request.Form("Smonth") + "/" + Request.Form("Sday")+ "/" + Request.Form("Syear")
varToday = Request.Form("Emonth") + "/" + Request.Form("Eday")+ "/" + Request.Form("Eyear")
elseif varState = "m" then
varYesterday = month(date()) & "/1/" & year(date())
varToday = date()
strYesterday = dateadd("d",-1,date())
elseif varState = "y" then
varYesterday = "1/1/" & year(date())
varToday = date()
strYesterday = dateadd("d",-1,date())
elseif varState = "s" then
varYesterday = Request.Form("Smonth") + "/" + Request.Form("Sday")+ "/" + Request.Form("Syear")
varToday = Request.Form("Emonth") + "/" + Request.Form("Eday")+ "/" + Request.Form("Eyear")
varInterval = Request.Form("Interval")
else
varYesterday = cdate(datepart("m",date()-1) & "/" & datepart("d",date()-1) & "/" & datepart("yyyy",date()-1))
varToday = cdate(datepart("m",date()) & "/" & datepart("d",date()) & "/" & datepart("yyyy",date()))
end if
if varCustomer = "0" then
strSQL = "select CustomerNo, SubNo, City, CustomerName from Customer order by CustomerName"
else
strSQL = "select CustomerNo, SubNo, City, CustomerName from Customer where CustomerNo = " & varCustomer & " and SubNo = " & varSub & " and City = " & varCity & " order by CustomerName"
end if
' sjs
dim DBCONN
set DBCONN = Server.CreateObject("ADODB.Connection")
DBCONN.CommandTimeout = 60000
DBCONN.ConnectionTimeout = 60000
DBCONN.Open "DSN=***;UID=***;PWD=***;"
set DBConnection = DBCONN
set DBQuery = Server.CreateObject("ADODB.Command")
DBQuery.ActiveConnection = DBConnection
DBQuery.CommandType = 1
DBQuery.CommandText = strSQL
DBQuery.CommandTimeout = 900
Err.Clear
set dbRS = DBQuery.Execute
AllUpdateCount = 0
AllInquiryCount = 0
AllMTCount = 0
AllETCount = 0
AllTotalCount = 0
index = 0
while not dbRS.EOF
index = index + 1
if Request.Form("Summary") = "prevd" then
strType = "Yesterday"
strNote = "(from " & varYesterday & ")"
strFormatSQL = "select distinct [Format] 'formatid' from TransactionSummary where CustomerNo = " & dbRS.Fields("CustomerNo").Value & " and SubNo = " & dbRS.Fields("SubNo").Value & " and City = " & dbRS.Fields("City").Value & " and TransactionDate = '" & varYesterday & "'"
elseif Request.Form("Summary") = "user" then
strType = "User Specified"
strFormatSQL = "select distinct [Format] 'formatid' from TransactionSummary where CustomerNo = " & dbRS.Fields("CustomerNo").Value & " and SubNo = " & dbRS.Fields("SubNo").Value & " and City = " & dbRS.Fields("City").Value & " and TransactionDate >= '" & varYesterday & "' and TransactionDate <= '" & varToday & "'"
strNote = "(from " & varYesterday & " to " & varToday & ")"
elseif Request.Form("Summary") = "mtd" then
strType = "Month To Date"
strFormatSQL = "select distinct [Format] 'formatid' from TransactionSummary where CustomerNo = " & dbRS.Fields("CustomerNo").Value & " and SubNo = " & dbRS.Fields("SubNo").Value & " and City = " & dbRS.Fields("City").Value & " and TransactionDate >= '" & varYesterday & "' and TransactionDate < '" & varToday & "'"
strNote = "(from " & varYesterday & " through " & varToday & ")"
elseif Request.Form("Summary") = "ytd" then
strType = "Year To Date"
strFormatSQL = "select distinct [Format] 'formatid' from TransactionSummary where CustomerNo = " & dbRS.Fields("CustomerNo").Value & " and SubNo = " & dbRS.Fields("SubNo").Value & " and City = " & dbRS.Fields("City").Value & " and TransactionDate >= '" & varYesterday & "' and TransactionDate < '" & varToday & "'"
strNote = "(from " & varYesterday & " through " & varToday & ")"
elseif Request.Form("Summary") = "stats" then
strType = "Usage Statistics"
strFormatSQL = "select TransactionDate from TransactionDetail where CustomerNo = " & dbRS.Fields("CustomerNo").Value & " and SubNo = " & dbRS.Fields("SubNo").Value & " and City = " & dbRS.Fields("City").Value & " and TransactionDate >= '" & varYesterday & "' and TransactionDate <= '" & varToday & " 11:59:59 PM'"
strNote = "(from " & varYesterday & " to " & varToday & ")"
else
strFormatSQL = ""
end if
'very top
if Request.Form("present") = "xls" then
if varCustomer = "0" and index = 1 then
objXL.Cells(5,2) = strType & " Summary For ALL Customers"
objXL.Cells(6,2) = strNote
end if
if varCustomer ="0" then
else
objXL.Cells(5,2) = strType & " Summary For Customer: " & Trim(dbRS.Fields("CustomerName").Value) & " - City " & Trim(dbRS.Fields("City").Value)
objXL.Cells(6,2) = strNote
end if
elseif Request.Form("present") <> "xls" then
if varCustomer = "0" and index = 1 then
Response.Write("<h3>" & strType & " Summary for All Customers<br>" & chr(13))
Response.Write("<font size=""-1"">" & strNote & "</font></h3>" & chr(13))
Response.Write("<table border=""1"" id=""exCity"" runat=""server"">" & chr(13))
Response.Write("<tr>" & chr(13))
Response.Write("<td align=""center""><strong>Customer</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>City</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>Inquiry</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>Update</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>Total</strong></td>" & chr(13))
Response.Write("</tr>" & chr(13))
end if
' Customer and City for ALL Customers added above each record top
if varCustomer = "0" then
' Response.Write("<h3><i>" & Trim(dbRS.Fields("CustomerName").Value) & " - Po------------rt " & Trim(dbRS.Fields("City").Value) & "</i></h3>" & chr(13))
'Customer and City for a single Customer added to very top
else
Response.Write("<h3>" & strType & " Summary for Customer: " & Trim(dbRS.Fields("CustomerName").Value) & " - City " & Trim(dbRS.Fields("City").Value) & "<br>" & chr(13))
Response.Write("<font size=""-1"">" & strNote & "</font></h3>" & chr(13))
'start a table with format request name transatctions at the top
Response.Write("<table border=""1"" id=""exCity"" runat=""server"">" & chr(13))
Response.Write("<tr>" & chr(13))
Response.Write("<td align=""center""><strong>Customer</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>City</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>Inquiry</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>Update</strong></td>" & chr(13))
Response.Write("<td align=""center""><strong>Total</strong></td>" & chr(13))
Response.Write("</tr>" & chr(13))
end if
end if
'query db for one Customer
DBQuery.CommandText = strFormatSQL
Err.Clear
set dbRS3 = DBQuery.Execute
UpdateTotalCount = 0
InquiryTotalCount = 0
MTTotalCount = 0
ETTotalCount = 0
CustomerTotalCount = 0
IntervalCounter = 0
IntervalStart = varYesterday & " 12:00:00 AM"
while not dbRS3.EOF
if varState = "s" then
Difference = datediff("n", IntervalStart, dbRS3.Fields("TransactionDate").Value)
if (CInt(Difference) < CInt(varInterval)) then
IntervalCounter = IntervalCounter + 1
else
IntervalNext = dateadd("n", varInterval, IntervalStart)
Response.Write("<tr><td align=""left"">" & IntervalStart & " to <br>" & IntervalNext & "</td><td align=""center"" valign=""middle"">" & IntervalCounter & "</td></tr>" & chr(13))
IntervalCounter = 0
IntervalStart = IntervalNext
end if
else
if Request.Form("Summary") = "prevd" then
strSQL = "select Sum(s.TransactionCount) 'hits', r.RequestName from TransactionSummary as s LEFT JOIN RepositoryDB.dbo.BLS_REQ as r ON s.[Format] = r.RequestID where s.CustomerNo = " & dbRS.Fields("CustomerNo").Value & " and s.SubNo = " & dbRS.Fields("SubNo").Value & " and s.City = " & dbRS.Fields("City").Value & " and s.TransactionDate = '" & varYesterday & "' and s.[Format] = " & dbRS3.Fields("formatid").Value & " GROUP BY r.RequestName"
else
strSQL = "select sum(s.TransactionCount) 'hits', r.RequestName from TransactionSummary as s LEFT JOIN RepositoryDB.dbo.BLS_REQ as r ON s.[Format] = r.RequestID where s.CustomerNo = " & dbRS.Fields("CustomerNo").Value & " and s.SubNo = " & dbRS.Fields("SubNo").Value & " and s.City = " & dbRS.Fields("City").Value & " and s.TransactionDate >= '" & varYesterday & "' and s.TransactionDate <= '" & varToday & "' and s.[Format] = " & dbRS3.Fields("formatid").Value & " GROUP BY r.RequestName"
end if
DBQuery.CommandText = strSQL
Err.Clear
set dbRS2 = DBQuery.Execute
If Err.Number <> 0 Then
Response.Write("Could not get Transaction Summary - database error. SQL Script = " & strSQL)
End If
' Count the hits into their respective total
If (Trim(dbRS3.Fields("formatid").Value) = 25) or (Trim(dbRS3.Fields("formatid").Value) = 425 )Then
MTTotalCount = MTTotalCount + dbRS2.Fields("hits").value
ElseIf (Trim(dbRS3.Fields("formatid").Value = 23)) Then
ETTotalCount = ETTotalCount + dbRS2.Fields("hits").value
ElseIf (Trim(dbRS3.Fields("formatid").Value) = 38) or _
((Trim(dbRS3.Fields("formatid").Value) >= 400) and _
(Trim(dbRS3.Fields("formatid").Value) <= 499) or _
((Trim(dbRS3.Fields("formatid").Value) >= 800) and _
(Trim(dbRS3.Fields("formatid").Value) <= 899))) Then
UpdateTotalCount = UpdateTotalCount + dbRS2.Fields("hits").value
Else
InquiryTotalCount = InquiryTotalCount + dbRS2.Fields("hits").value
End If
set dbRS2 = nothing
end if
dbRS3.MoveNext
wend
set dbRS3 = nothing
UpdateTotalCount = UpdateTotalCount + MTTotalCount + ETTotalCount
CustomerTotalCount = UpdateTotalCount + InquiryTotalCount
' show totals
if Request.Form("present") = "xls" then
objXL.Cells(numRow,2) = Trim(dbRS.Fields("CustomerName").Value)
objXL.Cells(numRow,3) = Trim(dbRS.Fields("City").Value)
objXL.Cells(numRow,4) = UpdateTotalCount
objXL.Cells(numRow,5) = InquiryTotalCount
objXL.Cells(numRow,6) = CustomerTotalCount
objXL.Range("B" & numRow & ":F" & numRow).BORDERS.Weight = 2
numRow = numRow + 1
end if
if Request.Form("present") <> "xls" then
if varState <> "s" then
Response.Write("<tr>" & chr(13))
Response.Write("<td align=""left"">" & Trim(dbRS.Fields("CustomerName").Value) & "</td>" & chr(13))
Response.Write("<td align=""center"">" & Trim(dbRS.Fields("City").Value) & "</td>" & chr(13))
Response.Write("<td align=""center"">" & UpdateTotalCount & "</td>" & chr(13))
Response.Write("<td align=""center"">" & InquiryTotalCount & "</td>" & chr(13))
Response.Write("<td align=""center"">" & CustomerTotalCount & "</td>" & chr(13))
Response.Write("</tr>" & chr(13))
else
IntervalNext = dateadd("n", varInterval, IntervalStart)
Response.Write("<tr><td align=""left"">" & IntervalStart & " to <br>" & IntervalNext & "</td><td align=""center"" valign=""middle"">" & IntervalCounter & "</td></tr>" & chr(13))
end if
' Response.Write("</table>" & chr(13))
end if
'set dbRS2 = nothing
dbRS.MoveNext
AllUpdateCount = AllUpdateCount + UpdateTotalCount
AllInquiryCount = AllInquiryCount + InquiryTotalCount
AllMTCount = AllMTCount + MTTotalCount
AllETCount = AllETCount + ETTotalCount
AllTotalCount = AllTotalCount + CustomerTotalCount
'do grand totals
wend
set dbRS = nothing
if Request.Form("present") <> "xls" then
Response.Write("</table>" & chr(13))
if varCustomer = "0" and varState <> "s" then
Response.Write("<h3>Grand Total Update = " & AllUpdateCount & "</h3>" & chr(13))
Response.Write("<h3>Grand Total Inquiry = " & AllInquiryCount & "</h3>" & chr(13))
Response.Write("<h3>Grand Total for All Customers = " & AllTotalCount & "</h3>" & chr(13))
Response.Write("<h3>Grand Total Manual Transactions = " & AllMTCount & "</h3>" & chr(13))
Response.Write("<h3>Grand Total Early Transactions = " & AllETCount & "</h3>" & chr(13))
end if
end if
end if
if Request.Form("present") <> "xls" then
%><!--#include file="../Common/footer.inc"--><%
end if
if Request.Form("present") = "xls" then
objXL.Cells(numRow+1,4) = "Copyright " & Year(Date)
objXL.Cells(numRow+2,4) = "All Rights Reserved"
Set Fso = CreateObject("Scripting.FileSystemObject")
If (Fso.FileExists("C:\Inetpub\temp\xl2.xlsx")) Then
Set MyFile = Fso.GetFile("C:\Inetpub\temp\xl2.xlsx")
MyFile.Delete
Set MyFile=nothing
End If
Set Fso=nothing
objWB.SaveAs "C:\Inetpub\temp\xl2.xlsx"
objWB.Close
objXL.Quit
Response.Redirect "/temp/xl2.asp"
end if
%>
This section of your code:
if Request.Form("present") = "xls" then
objXL.Cells(numRow,2) = Trim(dbRS.Fields("CustomerName").Value)
objXL.Cells(numRow,3) = Trim(dbRS.Fields("City").Value)
objXL.Cells(numRow,4) = UpdateTotalCount
objXL.Cells(numRow,5) = InquiryTotalCount
objXL.Cells(numRow,6) = CustomerTotalCount
objXL.Range("B" & numRow & ":F" & numRow).BORDERS.Weight = 2
numRow = numRow + 1
end if
Is referring to the Cells and Range objects with the wrong parent object. The parent to these would be the worksheet, which you have previously set as objWS. Also note that you really should set objWS like this:
Set objWS = objWB.Worksheets("Sheet1")
because the ActiveWorkbook can change when you least expect it... :)

search the database and put it in textbox

Using VB 6 and adodb connection, when I click search for id, a inputbox will appear, when it finds The id I wanted, it will automatically insert all the data of that row to their corresponding textboxes.
Here my code, at somepoint, it does not work, I dont remember the error but I will post it here when I get home, thanks for your help guys.
Private Sub cmdsearch_Click()
findemployee = InputBox("Insert Employee ID")
record.Open ("select * from employees where ID='" & findemployee & "'"), conn, 3, 3
If record.EOF Then
MsgBox "NO" & findemployee & " ID WAS NOT FOUND!", vbCritical + vbOKOnly, "Error Search"
Set record = Nothing
Else
txtemployeeid.Text = record!ID
txtlnames.Text = record!lastname
txtfnames.Text = record!Firstname
txtmnames.Text = record!middlename
cmbgenders.Text = record!gender
bdates.Value = record!birthdate
txtbplaces = record!birthplace
txtages = record!age
txtaddress.Text = record!address
cmbeducattainments.Text = record!educattainment
txtnos.Text = record!contactno
cstarts.Value = record!contractstart
cends.Value = record!contractend
Set record = Nothing
End If
End Sub
Private Sub cmdsearch_Click()
findemployee = inputtextbox.text
record.Open ("select * from employees where ID='" & findemployee & "'"), conn, 3, 3
If record.EOF Then
MsgBox "NO" & findemployee & " ID WAS NOT FOUND!", vbCritical + vbOKOnly, "Error Search"
Set record = Nothing
Else
with record
txtemployeeid.Text = !ID
txtlnames.Text = !lastname
txtfnames.Text = !Firstname
txtmnames.Text = !middlename
cmbgenders.Text = !gender
bdates.Value = !birthdate
txtbplaces = !birthplace
txtages = !age
txtaddress.Text = !address
cmbeducattainments.Text = !educattainment
txtnos.Text = !contactno
cstarts.Value = !contractstart
cends.Value = !contractend
Set record = Nothing
END WITH
End If
End Sub

Resources