DB Error Catching Function

[Dubya007]

I'm attempting to write a function that will catch the following error


Microsoft OLE DB Provider for ODBC Drivers error '80004005'

[Microsoft][ODBC SQL Server Driver][SQL Server]Cannot open database "FaCom" requested by the login. The login failed.

/uploadtest/file2.asp, line 27

I'd like it to catch that error and output a message that says "DB Connection Error" Or something to that effect. However since this is my first attempt at catching errors its not working.

<%
On Error Resume Next
OMS="FaCom"
OfferID ="FC-Money"

dim strSQL,Global_DBConnection,DSN,SQL,RS, Counter
set Global_DBConnection=Server.CreateObject("ADODB.Connection")

DSN="Driver={SQL Server};Server=.\SQL;Database="&OMS&";UID=sa;PWD=lynx111"
Global_DBConnection.Open(DSN)

SQL="SELECT * FROM OFFERS WHERE OFFERS_ID='"&OfferID&"' AND OFFERS_Inactive=0"

'response.write SQL &"<br>"
	
Set RS = Global_DBConnection.execute(SQL)

Do While Not RS.EOF
		Counter= Counter + 1
		RS.Movenext
	Loop
	RS.close

IF Counter<1 Then
	ErrorMessage = ErrorMessage & CurrentOrderID & ": " & OfferID & " - Invalid Offer Id or Inactive offer<br>"
	ErrorCount=ErrorCount+1
	DispOrder=True
End If

If Err.Number='80004005'
	response.write "DB Connection Error"
End If


%>

I've purposely set the OMS name incorrectly to figure how to catch the error.
Can anyone point me in the right direction? I've read up on it but I'm not finding the issue.

[si_the_geek]

First of all there are two problems on this line:

If Err.Number='80004005'

You are missing the Then, and you have put single quotes around the number (use double quotes for text, # for dates, nothing for numbers).

Next up, you have it in the wrong place - it needs to be immediately after the line of code that will generate the error (presumably Global_DBConnection.Open(DSN) ), otherwise you will get a different error (because the recordset can't open, etc). You should also put the code after it in an Else so that it doesn't run when it is bound to fail.

It would also be best to act on any error (If Err.Number <> 0 Then) rather than just a specific one, because there are many different errors that can occur while opening the connection - and they will all stop the rest of the code from working.

[Dubya007]

That worked. However I now have a new problem with it.
I have to loop through a tab delimited file and make sure that the DB names that are submitted are actually DB's.
My code is below (most of it for that Page)

<&#37; 
Option Explicit

Response.buffer=true
On Error Resume Next
Function ReadTextFile(strFilePath)
	Dim objFSO, objFile, strAllFile
	Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
	Set objFile = objFSO.OpenTextFile(strFilePath)
	strAllFile = ""
	If Not(objFile.AtEndOfStream) Then
		strAllFile = objFile.ReadAll
	End If
	objFile.Close
	Set objFile = Nothing
	Set objFSO = Nothing
	
	strAllFile = Replace(strAllFile, Chr(13)&Chr(10), Chr(13))
	strAllFile = Replace(strAllFile, Chr(10)&Chr(13), Chr(13))
	ReadTextFile = Split(strAllFile, Chr(13))
End Function
'**************************************************************************************************

Function CheckOffer(OMS, OfferID)
	Err.clear
	Response.Write "Line: "&x &" " &CurrentOrderID & " - CheckOffer<br>"
	Response.write ErrorMessage

	dim Global_DBConnection,DSN,SQL,RS, Counter
	set Global_DBConnection=Server.CreateObject("ADODB.Connection")
	DSN="Driver={SQL Server};Server=.\SQL;Database=" & OMS & ";UID=sa;PWD=lynx111"
	Global_DBConnection.Open(DSN)

	If Err.Number <>0 Then
	response.write Err.Number &"<br>"
		ErrorMessage = ErrorMessage &"<tr><td>" & CurrentOrderID & "</td><td> " & OMS & ": Invalid OMS Name</td></tr>"
		ErrorCount=ErrorCount+1
		response.write Err.Description &"<BR>"
	Else
		response.write Err.Number &"<br>"
		SQL="SELECT * FROM OFFERS WHERE OFFERS_ID='" & OfferID & "' AND OFFERS_Inactive=0"
		response.write SQL &"<br>"
		
		Set RS = Global_DBConnection.execute(SQL)
		
		Do While Not RS.EOF
			Counter= Counter + 1
			RS.Movenext
		Loop
		RS.close

		If Counter<1 Then
			ErrorMessage = ErrorMessage &"<tr><td>" & x &" "& OrderID & "</td><td> " & OfferID & ": Invalid Offer Id or Inactive offer</td></tr>"
			ErrorCount=ErrorCount+1
			Response.write "Invalid Offer<br>"
		End If

	End If 	'If Err.Number <> 0 Then
	'Err.Clear 'Clearing the Errors Out for the Next Iteration
End Function

'**************************************************************************************************
'usage
Const FILE_NAME="BatchFile.txt"
Dim arrLines, x, curLine, WordArray,OrderID,OrderCount,NewFile,Errors,OMS,OfferID
Dim ErrorCount,CurrentOrderID, ErrorMessage,DispOrder,Counter, GoodFormat
Dim GoodOMS
ErrorCount=0
Response.write Now() & "<br>"
Response.Write("reading file: " & FILE_NAME & "...<br />")
NewFile="InFiles\"&FILE_NAME
arrLines = ReadTextFile(Server.MapPath(NewFile))

For x=0 To UBound(arrLines)
	curLine = arrLines(x)
	If x = 0 Then									'0 is the header row of the file		
		'response.write CheckFormat()
	Else
		WordArray=Split(curLine,vbTab)		'Putting Each line into an array
		OMS=WordArray(0)						'Setting the OMS
		OfferID=WordArray(19)				'Setting the OfferID

		'Displaying the Ordernumber
		'*************************************************************************************************
		OrderID=WordArray(22)
		If CurrentOrderID<>OrderID Then			'If ordernumber is equal to currentorderid then exit the function doing nothing.
			OrderCount=OrderCount + 1				'add 1 to the number of orders for counting
			CurrentOrderID=OrderID					'setting the OrderID for the next iteration
			DispOrder=DispOrder &OrderCount &". " & CurrentOrderID & "<br>"
		End If
		'*************************************************************************************************
		response.write CheckOffer(OMS,OfferID)			'checking the offer for this line		
	End If
	
	response.write "---------------------------------------------------------------------------<br>"

The problem is that it isn't catching an error in the correct line. For some reason when I encounter an error with the DB name the "If Err.Number <>0 Then" doesn't fire until the next iteration of the loop.

i know this must be a logic problem so if any one knows how to go about this any help will be appreciated.

[si_the_geek]

I don't use VBScript much, but based on the other variations of VB I presume that On Error Resume Next only affects the routine it is in - and because you haven't got it in the functions, it is probably only running in the main body of the code (and therefore exiting the function as soon as an error occurs).