Classic ASP - Catching 500 Errors - iis

I'm trying to diagnose a problem with a site that seems to be throwing an error in the code somewhere. From the error logs it seems be an SQL syntax error caused by bad concatenation of an SQL query with bad code. My problem is, I can't reproduce the error but customers are still getting it and it could be cause by a number of queries. So my plan is to create my own 500 error page to catch the result.
I want to get the page to catch all session data, all POST and GET data (which I can do) but I also want to catch detailed information about the error. Pretty much what would show on the page when the site allows errors to be shown. With the little arrow specifying the line.
Is there a way to catch the error from the custom 500 error page?
Thanks in advance
Grant

You can get good, but not great info from ASP when you have an error.
But you can define a custom 500 error code page in ASP land that can give you a bit more info when your program crashes. Here's some sample code that will build a pretty decent error message about your error.
Set objASPError = Server.GetLastError
Dim strProblem
strProblem = "ASPCode: " & Server.HTMLEncode(objASPError.ASPCode) & vbCrLf
strProblem = strProblem & "Number: 0x" & Hex(objASPError.Number) & vbCrLf
strProblem = strProblem & "Source: [" & Server.HTMLEncode(objASPError.Source) & "]" & vbCrLf
strProblem = strProblem & "Category: " & Server.HTMLEncode(objASPError.Category) & vbCrLf
strProblem = strProblem & "File: " & Server.HTMLEncode(objASPError.File) & vbCrLf
strProblem = strProblem & "Line: " & CStr(objASPError.Line) & vbCrLf
strProblem = strProblem & "Column: " & CStr(objASPError.Column) & vbCrLf
strProblem = strProblem & "Description: " & Server.HTMLEncode(objASPError.Description) & vbCrLf
strProblem = strProblem & "ASP Description: " & Server.HTMLEncode(objASPError.ASPDescription) & vbCrLf
strProblem = strProblem & "Server Variables: " & vbCrLf & Server.HTMLEncode(Request.ServerVariables("ALL_HTTP")) & vbCrLf
strProblem = strProblem & "QueryString: " & Server.HTMLEncode(Request.QueryString) & vbCrLf
strProblem = strProblem & "URL: " & Server.HTMLEncode(Request.ServerVariables("URL")) & vbCrLf
strProblem = strProblem & "Content Type: " & Server.HTMLEncode(Request.ServerVariables("CONTENT_TYPE")) & vbCrLf
strProblem = strProblem & "Content Length: " & Server.HTMLEncode(Request.ServerVariables("CONTENT_LENGTH")) & vbCrLf
strProblem = strProblem & "Local Addr: " & Server.HTMLEncode(Request.ServerVariables("LOCAL_ADDR")) & vbCrLf
strProblem = strProblem & "Remote Addr: " & Server.HTMLEncode(Request.ServerVariables("LOCAL_ADDR")) & vbCrLf
strProblem = strProblem & "Time: " & Now & vbCrLf
Edit On IIS7 GetLastError doesn't seem to have any info available.
You can workaround the problem by creating a 500.100 and point this at your script.
YMMV, check these URLS for more info http://forums.iis.net/t/1150502.aspx and http://www.tacticaltechnique.com/web-development/classic-asp-getlasterror-in-iis7/

Generally you set "on error resume next", then check for the error code "Err.Number" after the offending line of code for non-zero values.
See: http://www.powerasp.com/content/new/on-error-resume-next.asp

Related

Adding line breaks in HTMLBody email code

When my email generates it doesn't have the line breaks despite using the "& vbCrLf &" code. I've tried using the <br> and <p> but I get compile errors every time.
Can someone please take a look at my code and help a brother out?
Dim strbody As String
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
With xEmailObj
.Display
.to = xMemberName5
.CC = ""
.Subject = "Annual Review " + xMemberName + " " + "Cust " + xMemberName3
strbody = "<p style='font-family:calibri;font-size:11pt;color:rgb(31,78,121)'>" + xMemberName7 + "," _
& vbCrLf & vbCrLf & "Our records indicate that " + xMemberName + " is due for an annual pricing review. We are seeking an overall impact of " + xMemberName6 + "% increase to the rates. Updated Tariff page is attached." _
& vbCrLf & "If there are any pricing issues which need to be addressed, please get back to me no later than " & CDate(Date + 7) & "." _
& vbCrLf & vbCrLf & "Otherwise, the attached new pricing will be effective " + xMemberName4 + ". I encourage you to visit with your customer and deliver the new pricing ASAP." & .HTMLBody & "</body>"
.HTMLBody = strbody
Just include the <br>directly in your string as you did with <p> already
strbody = "<p style='font-family:calibri;font-size:11pt;color:rgb(31,78,121)'>" & xMemberName7 & "," _
& "<br><br>Our records indicate that " & xMemberName & " is due for an annual pricing review. We are seeking an overall impact of " & xMemberName6 & "% increase to the rates. Updated Tariff page is attached." _
& "<br>If there are any pricing issues which need to be addressed, please get back to me no later than " & CDate(Date + 7) & "." _
& "<br><br>Otherwise, the attached new pricing will be effective " & xMemberName4 & ". I encourage you to visit with your customer and deliver the new pricing ASAP." & .HTMLBody & "</body>"
And I recommend to use & instead of + to concatenate your variables with strings.

VBA Adodb : concatenation of values

I would like to use in my query the key like this: '"prod.cd_produit"'||'"/"'||'" & strQ & "'.
Here, the values of my variables are: prod.cd_produit= 53 and & strQ & =350, so I would like to have 53/350 as a key.
I'm wondering if it's right to write '"prod.cd_produit"'||'"/"'||'" & strQ & "' (I don't want to have any spaces neither at right nor at left). This is a part of my code :
Public Sub INFO_PROTO34(ByRef strQ As String)
...........................................
" sousc.lp_etat_doss not in ('ANNUL','A30','IMPAY') and sousc.is_produit = prod.is_produit" & _
" and '"prod.cd_produit"'||'"/"'||'" & strQ & "' = proto.cd_protocole ",
Thank you very much for your help!
Like this:
RECSET.Open " select proto.b_perf_cma as b_perf_cma from db_dossier sousc,db_produit prod, " & _
" db_protocole proto where sousc.no_police = '" & numero_de_police & "' " & _
" and sousc.cd_dossier = 'SOUSC' " & _
" and sousc.lp_etat_doss not in ('ANNUL','A30','IMPAY') " & _
" and sousc.is_produit = prod.is_produit " & _
" and prod.cd_produit||'/'||'" & strQ & "' = proto.cd_protocole ", _
cnn_Pegase, adOpenDynamic, adLockBatchOptimistic
helps to spend some time formatting your SQL so it's more readable (for us and you...)

OLEDB Update Query fails to update .xlsm file

i'm trying to update an already open macro file (.xlsm) using update Query. the Update Query updates the the macro sheet sometimes but misses to update the sheet in some cases where there is no error appearing in this case.
My connection strig:
connstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath & ";Extended Properties=""Excel 12.0 Macro;HDR=YES"";"
Update Query:
strSQL = "UPDATE [" & QuerySheet & "] SET [Alias]= '" & Alias &
"',[Tolerable Error]= '" & TE & "', [Account Type]= '" &
AccountTypeList & "',[Account Sub-Type]= '" & AccountSubTypeList &
"',[Account Class]= '" & AccountClassCheckbox & "' ,[Account
Sub-Class]= '" & AccountSubClassCheckbox & "',[GL Accounts]= '" &
GLAccountsCheckbox & "',[Scoping Dropdown Selection]= '" &
ComboBoxSelectedValue & "',[Account Type (ALL)]='" & AccountTypeList &
"',[Account Sub-type (ALL)]='" & AccountSubTypeList & "',[Account
Class (ALL)]='" & AccountClassList & "',[Account Sub-class (ALL)]='" &
AccountSubClassList & "',[GL Accounts (ALL)]='" & GLAccountList & "'
Where [Category Name]= '" & PrimaryStatement & "' AND [Group]='" &
GroupCounter & "'"
strSQL = "UPDATE [" & QuerySheet & "] SET [Alias]= '" & Alias & "',[Tolerable Error]= '" & TE & "', [Account Type]= '" & AccountTypeList & "',[Account Sub-Type]= '" & AccountSubTypeList & "',[Account Class]= '" & AccountClassCheckbox & "' ,[Account Sub-Class]= '" & AccountSubClassCheckbox & "',[GL Accounts]= '" & GLAccountsCheckbox & "',[Scoping Dropdown Selection]= '" & ComboBoxSelectedValue & "',[Account Type (ALL)]='" & AccountTypeList & "',[Account Sub-type (ALL)]='" & AccountSubTypeList & "',[Account Class (ALL)]='" & AccountClassList & "',[Account Sub-class (ALL)]='" & AccountSubClassList & "',[GL Accounts (ALL)]='" & GLAccountList & "' Where [Category Name]= '" & PrimaryStatement & "' AND [Group]='" & GroupCounter & "'"

Compile Error: Procedure Too Large help needed

I'm working on a large Excel project that requires entering a lot of data spread out over the worksheet that needs to be entered as quick as possible. To try and aide with the entry, I've created a number of UserForms that the user would enter the data into. One such form returns the above "Process Too Large" error when trying to transfer the data.
I understand why the error pops up - it's far too long. I've included the code for one such entry (slightly modified of course) and was wondering how I would be able to truncate it?
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Sheets("STOCK")
' 101
If entry101.Value <> "" Then
Dim NUM101 As String
If com101.Value <> "" Then
NUM101 = "# - " & UCase(com101.Value)
Else
NUM101 = ""
End If
If cmb101.Value = "FULL" Then
ws.Range("_101").Value = UCase(code101.Value) & " " & Chr(10) & UCase(com101.Value) & " - FULL " & Chr(10) & " "
End If
If cmb101.Value = "OUT OF STOCK" Then
ws.Range("_101").Value = UCase(com101.Value) & " OUT OF STOCK " & Chr(10) & UCase(code101.Value) & " " & Chr(10) & " "
End If
If cmb101.Value = "SHIPPED" Then
ws.Range("_101").Value = UCase(code101.Value) & " " & Chr(10) & " - SHIPPED " & Chr(10) & NUM101
End If
If cmb101.Value = "DAMAGED" Then
ws.Range("_101").Value = UCase(code101.Value) & " DAMAGED " & Chr(10) & " "" & Chr(10) & NUM101"
End If
If cmb101.Value = "LOW STOCK" Then
ws.Range("_101").Value = UCase(com101.Value) & " LOW-STOCK " & Chr(10) & UCase(code101.Value) & " " & Chr(10) & " "
End If
If cmb101.Value = "RETURN" Then
ws.Range("_101").Value = UCase(code101.Value) & " " & Chr(10) & "RETURNED - " & UCase(com101.Value) & " " & Chr(10) & " "
End If
If cmb101.Value = "" Then
ws.Range("_101").Value = UCase(code101.Value) & Chr(10) & " - UNKNOWN CONDITION"
End If
End If
The UserForm has two text boxes ("code101" & "com101") and a single ComboBox ("cmb101") for each entry. The above code needs to be applied to a range from "_101" to "_143" so needs to repeat 43 times.
Any help would be greatly appreciated. Thank you all.
Something like this (untested):
Dim ws As Worksheet, vCom, vCode
Dim i As Long, s, num As String
Set ws = ThisWorkbook.Sheets("STOCK")
For i = 101 To 143
If Me.Controls("entry" & i).Value <> "" Then
vCom = UCase(Me.Controls("com" & i).Value)
vCode = UCase(Me.Controls("code" & i).Value)
num = IIf(vCom <> "", "# - " & vCom, "")
s = ""
Select Case Me.Controls("cmb" & i).Value
Case "FULL": s = vCode & " " & Chr(10) & vCom & " - FULL " & Chr(10) & " "
Case "OUT OF STOCK": s = vCom & " OUT OF STOCK " & Chr(10) & vCode & " " & Chr(10) & " "
Case "SHIPPED": s = vCode & " " & Chr(10) & " - SHIPPED " & Chr(10) & num
'etc
'etc
End Select
If Len(s) > 0 Then ws.Range("_" & i).Value = s
End If
Next i

Adding an If Statement into Html e-mail text in excel VBA

I am trying to add in an if statement half way through a HTML body of text I am using in VBA to send an e-mail.
I need to work out how to get the code to add extra hyperlinks if a cell in on one of the tabs has a value, there could be up to five that may need to be added.
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
.To = Accounts
.Subject = "Consolidated Account Statement " & myPolicynumber & " - " & mypolicyname
If myhyperlink2 = "" Then
.HTMLBody = "<HTML><BODY>" & "<FONT-size=""11.0pt"">" & "Hi Accounts" & "<br><br>" & _
" The Account Statement" & _
" for " & myPolicynumber & " (" & mypolicyname & ") is ready to be created. " & "<br><br>" & "<br><br>" & _
" The following Medical Extra Premium also need booking " & "<br><br>"
If Worksheets("FOR PA").Cells(13, 39).Value = "Medicals" Then
" Medical Extra Premium 1" & "<br><br>" & _
" Medical Extra Premium 2" & "<br><br>" & _
" Medical Extra Premium 3" & "<br><br>" & _
" Medical Extra Premium 4" & "<br><br>" & _
" Medical Extra Premium 5" & "<br><br>" & _
" Kind Regards," &.HTMLBody
.Send
Else
.HTMLBody = "<HTML><BODY>" & "<FONT-size=""11.0pt"">" & "Hi Accounts" & "<br><br>" & _
" The Initial" & " and the " & "Final & are ready to be put on the Account Statement " & _
" for " & myPolicynumber & " (" & mypolicyname & ") is ready to be created. " & "<br><br>" & _
" Kind Regards," & .HTMLBody
.Send
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
You're doing the right thing, but you're missing a .HTMLBody = before one of the options:
If Worksheets("FOR PA").Cells(13, 39).Value = "Medicals" Then
.HTMLBody = " Medical Extra Premium 1" & "<br><br>" & _
" Medical Extra Premium 2" & "<br><br>" & _

Resources