Allow for more or less data 1

Shelby500 · Oct 16, 2013

My code is below. The amount of data in my query changes and I'm having a hard time make it so the code can allow for the changes in the data. Right now it is all hard coded. The code is very simple and I'm learning slowly.

Code:

Dim strCon
Dim SQLArray

theDate = date()
newDate = DateAdd("D", -1, theDate)

'Connect to Oracle Database
strCon = "Data Source=servername:port/service;password=password;User ID=userid;Provider=OraOLEDB.Oracle.1;Persist Security Info=True;"

Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
Set oRs = oCon.Execute("select c.lead_stat_desc, b.lead_disp_desc, count(*) from lead a, lead_disp_ref b, lead_stat_ref c where a.dept_cd = 'END_OF_DRAW' and (a.del_stat_cd is null or a.del_stat_cd in ('CASCADE_RST','RST')) and a.lead_disp_ref_id = b.lead_disp_ref_id and a.lead_stat_ref_id = c.lead_stat_ref_id and c.dept_cd = 'END_OF_DRAW' group by c.lead_stat_desc,b.lead_disp_desc order by c.lead_stat_desc,b.lead_disp_desc,count(*)")

'oRs.Open SQLStmt
'SQLArray = oRs.GetRows(,,"COUNT(*)")
SQLArray = oRs.GetRows(,,Array(CStr("LEAD_STAT_DESC"),CStr("LEAD_DISP_DESC"),CStr("COUNT(*)")))
'oRs.Close

'Begin writing to variables

	strResults = "<TABLE BORDER=2 CELLPADDING=2 CELLSPACING=2 WIDTH=500><TR><TD WIDTH=300>" & fixStrLen("LEAD_STAT_DESC",20) & "</TD><TD WIDTH=600>" & fixStrLen("LEAD_DISP_DESC",30) & "</TD>" & "<TD WIDTH=100>" & fixStrLen("COUNT(*)",10) & "</TD></TR>"
	strResults2 = strResults & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0,0), 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1,0), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2,0), 10) & "</center></TD></TR>"
	strResults3 = strResults2 & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0,1), 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1,1), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2,1), 10) & "</center></TD></TR>"
	strResults4 = strResults3 & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0,2), 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1,2), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2,2), 10) & "</center></TD></TR>"
	strResults5 = strResults4 & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0,3), 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1,3), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2,3), 10) & "</center></TD></TR>"
	strResults6 = strResults5 & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0,4), 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1,4), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2,4), 10) & "</center></TD></TR>"
	strResults7 = strResults6 & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0,5), 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1,5), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2,5), 10) & "</center></TD></TR>"
	strResults8 = strResults7 & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0,6), 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1,6), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2,6), 10) & "</center></TD></TR></TABLE>"

oCon.Close
Set oRs = Nothing
Set oCon = Nothing

'send the email
sendemail "blah@blah.com", "blahblah@blah.com", "EOD Status/Disposition Report for " & date, strResults8

'Format Output
function fixStrLen(strValue, intLength)
   fixStrLen = left(strValue & space(intLength), intLength)
end function

Function Lpad (inputStr, padChar, lengthStr)  
    Lpad = string(lengthStr - Len(inputStr),padChar) & inputStr  
End Function

'Send email notification function
function sendEmail (strTo, strFrom, strSubject, strBody)
   set objEmail = CreateObject("CDO.Message")
   objEmail.From = strFrom
   objEmail.To = strTo
   objEmail.Subject = strSubject
   objEmail.HTMLBody = strBody
   objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
   objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "servername"
   objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
   objEmail.Configuration.Fields.Update
   objEmail.Send
end function

Geates · Oct 16, 2013

I think what you're asking about is a [tt]for loop?[/tt]

Code:

strBegin = "<TABLE BORDER=2 CELLPADDING=2 CELLSPACING=2 WIDTH=500>"
strHead = "<TR><TD WIDTH=300>" & fixStrLen("LEAD_STAT_DESC",20) & "</TD><TD WIDTH=600>" & fixStrLen("LEAD_DISP_DESC",30) & "</TD>" & "<TD WIDTH=100>" & fixStrLen("COUNT(*)",10) & "</TD></TR>"
strRows = ""
for i = 0 to ubound(SQLArray)
   strRows = strRows & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0, [COLOR=#FF0000][b]i[/b][/color], 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1, [COLOR=#FF0000][b]i[/b][/color]), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2, [COLOR=#FF0000][b]i[/b][/color]), 10) & "</center></TD></TR>"
next
strResults = strBegin & strHead & strRows & "</TABLE>"

-Geates

http://ns7.webmasters.com/caspdoc/html/vbscript_language_reference.htm

Shelby500 · Oct 16, 2013

That somewhat works but for some reason it only writes the first 3 data elements. I've confirmed that there is more data. See below. I've posted my SQL query against the database and the output from the script to show comparison.

SQL Results

Code:

LEAD_STAT_DESC 	LEAD_DISP_DESC 	    COUNT 
Completed 	Withdrawn 	        1 
Refinance 	Closing Requested 	1 
Refinance 	Data Entry 	        1 
Refinance 	Pending Credit UW 	13 
Refinance 	Pending Vendor Work 	4 
Refinance 	Pending income Docs 	2 
Refinance 	SAM - Pending Review 	2

Script Results

Code:

LEAD_STAT_DESC 	LEAD_DISP_DESC 	  COUNT(*) 
Completed 	Withdrawn 	        1 
Refinance 	Closing Requested 	1 
Refinance 	Data Entry 	        1

Shelby500 · Oct 16, 2013

Got it....wrong dimension. Works great now. Thanks.

Code:

strBegin = "<TABLE BORDER=2 CELLPADDING=2 CELLSPACING=2 WIDTH=500>"
strHead = "<TR><TD WIDTH=300>" & fixStrLen("LEAD_STAT_DESC",20) & "</TD><TD WIDTH=600>" & fixStrLen("LEAD_DISP_DESC",30) & "</TD>" & "<TD WIDTH=100>" & fixStrLen("COUNT(*)",10) & "</TD></TR>"
strRows = ""
for i = 0 to ubound(SQLArray,2)
   strRows = strRows & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0, i, 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1, i), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2, i), 10) & "</center></TD></TR>"
next
strResults = strBegin & strHead & strRows & "</TABLE>"

Geates · Oct 16, 2013

ubound(SQLArray,2)

Ah, of course (and a few missing parenthesis). Glad you got it working.

-Geates

http://ns7.webmasters.com/caspdoc/html/vbscript_language_reference.htm

Shelby500 · Oct 16, 2013

Geates, any idea how to keep the header words from putting the last character on the next line? I've tried everything that I can think of in HTML to do it and I can't for the life of me figure it out. The "LEAD_STAT_DESC" and the rest of the headers are doing this below. I've tried 100% and nowrap and hidden and whitespace and nothing has worked.

LEAD_STAT_DES
C

Code:

strBegin = "<TABLE BORDER=2 CELLPADDING=2 CELLSPACING=2 WIDTH=500>"
strHead = "<TR><TD WIDTH=300>" & fixStrLen("LEAD_STAT_DESC",20) & "</TD><TD WIDTH=600>" & fixStrLen("LEAD_DISP_DESC",30) & "</TD>" & "<TD WIDTH=100>" & fixStrLen("COUNT(*)",10) & "</TD></TR>"
strRows = ""
for i = 0 to ubound(SQLArray,2)
   strRows = strRows & "<TR><TD WIDTH=300>" & fixStrLen(SQLArray(0, i, 20) & "</TD><TD WIDTH=500>" & fixStrLen(SQLArray(1, i), 30) & "</TD><TD WIDTH=100><center>" & fixStrLen(SQLArray(2, i), 10) & "</center></TD></TR>"
next
strResults = strBegin & strHead & strRows & "</TABLE>"

guitarzan · Oct 16, 2013

Using NOWRAP and not specifying a width should work:

Code:

strHead = "<TR><TD NOWRAP>" & fixStrLen("LEAD_STAT_DESC",20) & "</TD>" & _
   "<TD NOWRAP>" & fixStrLen("LEAD_DISP_DESC",30) & "</TD>" & _
   "<TD NOWRAP>" & fixStrLen("COUNT(*)",10) & "</TD></TR>"

Shelby500 · Oct 16, 2013

That didn't work. I'm at a loss. hmm...

Shelby500 · Oct 16, 2013

Ok....I got it. This has to be used. Works great for IE8 anyway.

style=WORD-BREAK:BREAK-ALL;

Shelby500 · Oct 18, 2013

Another question. Is this the fastest way to do this if the data is 1000's of rows? It seems to take an extended amount of time to execute even for just 1100 rows of data.

PHV · Oct 18, 2013

What happens if you get rid of all the calls to fixStrLen ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

Shelby500 · Oct 18, 2013

That's right PHV. Those are no longer needed since I'm using HTML. I'll give that a try and see what it does. It is currently still running. It's been about 5 minutes. I'll give it another few minutes before I manually kill it and give this a try. I'll post my results shortly

Shelby500 · Oct 18, 2013

I took fixStrLen out of the equation and ran the script again. It ran for exactly 5 minutes. The email was 3MB. I guess that isn't bad considering it was about 3000 lines of data. PHV, is there anything else that might speed it up? I'm new at this game and learning slowly.

PHV · Oct 18, 2013

What is your actual code ?
Which amount of time is spent just for data retrieval (execution of SQL and GetRows) ?

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

Shelby500 · Oct 18, 2013

Here you go.

Code:

Dim strCon
Dim SQLArray

theDate = date()
newDate = DateAdd("D", -1, theDate)

strCon = "Data Source=<servername>:3203/SE001U;password=<pwd>;User ID=<userid>;Provider=OraOLEDB.Oracle.1;Persist Security Info=True;"

Dim oCon: Set oCon = WScript.CreateObject("ADODB.Connection")
Dim oRs: Set oRs = WScript.CreateObject("ADODB.Recordset")
oCon.Open strCon
'Has data
Set oRs = oCon.Execute("select SUBSTR(requeststring, INSTR(requeststring, 'first_name=', 1, 1)+11, INSTR(requeststring, 'last_name',1,1)-INSTR(requeststring,'first_name=',1,1)-12) AS appNameFirst, SUBSTR(requeststring, INSTR(requeststring, 'last_name=', 1, 1)+10, INSTR(requeststring, 'lead_source',1,1)-INSTR(requeststring,'last_name=',1,1)-11) AS appNameLast, SUBSTR(requeststring, INSTR(requeststring, '0wpuW=', 1, 1)+6, INSTR(requeststring, '00N30000000wdlg',1,1)-INSTR(requeststring,'0wpuW=',1,1)-10) AS appAddress, SUBSTR(requeststring, INSTR(requeststring, '00wq3X=', 1, 1)+7, INSTR(requeststring, '00N30000000wpuW',1,1)-INSTR(requeststring,'00wq3X=',1,1)-8) AS appCity, SUBSTR(requeststring, INSTR(requeststring, '00wpy1=', 1, 1)+7) AS appZip, TO_CHAR(logtime,'MM/DD/YYYY HH24:MISS') AS last_updated_date, SUBSTR(requeststring, INSTR(requeststring, '00wf7E=', 1, 1)+7, INSTR(requeststring, 'oid=',1,1)-INSTR(requeststring,'00wf7E=',1,1)-8) AS marketSourceCode, messageid from se.t_messaging_log m where logtime > TO_DATE('10-01-3 01:00', 'MM-DD-YY HH24:MI') and functioncategory = 'AgentApp-salesForceRequestUrl-bankerApp'")

'Test for 0 Records
'Set oRs = oCon.Execute("select SUBSTR(requeststring, INSTR(requeststring, 'first_name=', 1, 1)+11, INSTR(requeststring, 'last_name',1,1)-INSTR(requeststring,'first_name=',1,1)-12) AS appNameFirst, SUBSTR(requeststring, INSTR(requeststring, 'last_name=', 1, 1)+10, INSTR(requeststring, 'lead_source',1,1)-INSTR(requeststring,'last_name=',1,1)-11) AS appNameLast, SUBSTR(requeststring, INSTR(requeststring, '0wpuW=', 1, 1)+6, INSTR(requeststring, '00N30000000wdlg',1,1)-INSTR(requeststring,'0wpuW=',1,1)-10) AS appAddress, SUBSTR(requeststring, INSTR(requeststring, '00wq3X=', 1, 1)+7, INSTR(requeststring, '00N30000000wpuW',1,1)-INSTR(requeststring,'00wq3X=',1,1)-8) AS appCity, SUBSTR(requeststring, INSTR(requeststring, '00wpy1=', 1, 1)+7) AS appZip, TO_CHAR(logtime,'MM/DD/YYYY HH24:MISS') AS last_updated_date, messageid from se.t_messaging_log m where logtime > TO_DATE('10-01-13 08:00', 'MM-DD-YY HH24:MI') and functioncategory = 'AgentApp-salesForceRequestUrl-bankerApp'")

'Original SQL
'select messageid, application_id, requeststring, SUBSTR(requeststring, INSTR(requeststring, 'first_name=', 1, 1)+11, INSTR(requeststring, 'last_name',1,1)-INSTR(requeststring,'first_name=',1,1)-12) AS "appNameFirst", SUBSTR(requeststring, INSTR(requeststring, 'last_name=', 1, 1)+10, INSTR(requeststring, 'lead_source',1,1)-INSTR(requeststring,'last_name=',1,1)-11) AS "appNameLast", TO_CHAR(logtime,'DD-MON-YY HH24.MI.SS') AS last_updated_date from se.t_messaging_log m where logtime > TO_DATE('10-07-13 08:00', 'MM-DD-YY HH24:MI') and functioncategory = 'AgentApp-salesForceRequestUrl-bankerApp'

'UAT Test SQL
'select messageid, application_id, requeststring, SUBSTR(requeststring, INSTR(requeststring, 'first_name=', 1, 1)+11, INSTR(requeststring, 'last_name',1,1)-INSTR(requeststring,'first_name=',1,1)-12) AS "appNameFirst", SUBSTR(requeststring, INSTR(requeststring, 'last_name=', 1, 1)+10, INSTR(requeststring, 'lead_source',1,1)-INSTR(requeststring,'last_name=',1,1)-11) AS "appNameLast", TO_CHAR(logtime,'DD-MON-YY HH24.MI.SS') AS last_updated_date from se.t_messaging_log m where logtime > TO_DATE('08-07-13 08:00', 'MM-DD-YY HH24:MI') and functioncategory = 'AgentApp-salesForceRequestUrl-bankerApp' and messageid = '1130978'

If oRs.BOF or oRs.EOF = "True" then
	strEmpty = "<TABLE BORDER=2 CELLPADDING=2 CELLSPACING=2 style=table-layout:fixed;><TR><TD><center><b>" & fixStrLen("App_First_Name",50) & "</center></TD><TD><center><b>" & fixStrLen("App_Last_Name",50) & "</center></TD><TD><center><b>" & fixStrLen("App_Address",50) & "</center></TD><TD><center><b>" & fixStrLen("App_City",50) & "</center></TD><TD><center><b>" & fixStrLen("App_Zip",50) & "</center></TD><TD><center><b>" & fixStrLen("Last_Update",50) & "</center></TD><TD><center><b>" & fixStrLen("Market_Source_Code",50) & "</center></TD><TD><center><b>" & fixStrLen("Message_ID",50) & "</center></TD></TR></TABLE>"
'	strEmpty = "<TABLE BORDER=2 CELLPADDING=2 CELLSPACING=2 style=table-layout:fixed;><TR><TD><center><b>" & "App_First_Name" & "</center></TD><TD><center><b>" & "App_Last_Name" & "</center></TD><TD><center><b>" & "App_Address" & "</center></TD><TD><center><b>" & "App_City" & "</center></TD><TD><center><b>" & "App_Zip" & "</center></TD><TD><center><b>" & "Last_Update" & "</center></TD><TD><center><b>" & "Market_Source_Code" & "</center></TD><TD><center><b>" & "Message_ID" & "</center></TD></TR></TABLE>"
	strResults = strEmpty & vbCr & "<H1><b>0 Records Found!</H1>"
	sendemail "guy@blah.com", "guy@blah.com", "TESTING UAT Report for " & date, strResults
	Wscript.quit
Else
	SQLArray = oRs.GetRows(,,Array(CStr("appNameFirst"),CStr("appNameLast"),CStr("appAddress"),CStr("appCity"),CStr("appZip"),CStr("LAST_UPDATED_DATE"),CStr("MARKETSOURCECODE"),CStr("MESSAGEID")))
End If

'Begin writing array to variable

strBegin = "<TABLE BORDER=2 CELLPADDING=2 CELLSPACING=2 style=table-layout:fixed;>"
strHead = "<TR><TD><center><b>" & fixStrLen("App_First_Name",50) & "</center></TD><TD><center><b>" & fixStrLen("App_Last_Name",50) & "</center></TD><TD><center><b>" & fixStrLen("App_Address",50) & "</center></TD><TD><center><b>" & fixStrLen("App_City",50) & "</center></TD><TD><center><b>" & fixStrLen("App_Zip",50) & "</center></TD><TD><center><b>" & fixStrLen("Last_Update",50) & "</center></TD><TD><center><b>" & fixStrLen("Market_Source_Code",50) & "</center></TD><TD><center><b>" & fixStrLen("Message_ID",50) & "</center></TD></TR>"
'strHead = "<TR><TD><center><b>" & "App_First_Name" & "</center></TD><TD><center><b>" & "App_Last_Name" & "</center></TD><TD><center><b>" & "App_Address" & "</center></TD><TD><center><b>" & "App_City" & "</center></TD><TD><center><b>" & "App_Zip" & "</center></TD><TD><center><b>" & "Last_Update" & "</center></TD><TD><center><b>" & "Market_Source_Code" & "</center></TD><TD><center><b>" & "Message_ID" & "</center></TD></TR>"
strRows = ""

for i = 0 to ubound(SQLArray,2)
'   strRows = strRows & "<TR style=WORD-BREAK:BREAK-ALL;><TD NOWRAP><center>" & fixStrLen(SQLArray(0, i),50) & "</center></TD><TD NOWRAP><center>" & fixStrLen(SQLArray(1, i),50) & "</center></TD><TD style=word-wrap: break-word;>" & fixStrLen(SQLArray(2, i), 500) & "</center></TD><TD NOWRAP><center>" & fixStrLen(SQLArray(3, i),50) & "</center></TD><TD NOWRAP><center>" & fixStrLen(SQLArray(4, i),50) & "</center></TD><TD NOWRAP><center>" & fixStrLen(SQLArray(5, i),50) & "</center></TD><TD NOWRAP><center>" & fixStrLen(SQLArray(6, i),50) & "</center></TD><TD NOWRAP><center>" & fixStrLen(SQLArray(7, i),50) & "</center></TD></TR>"
   strRows = strRows & "<TR style=WORD-BREAK:BREAK-ALL;><TD NOWRAP><center>" & SQLArray(0, i) & "</center></TD><TD NOWRAP><center>" & SQLArray(1, i) & "</center></TD><TD style=word-wrap: break-word;>" & SQLArray(2, i) & "</center></TD><TD NOWRAP><center>" & SQLArray(3, i) & "</center></TD><TD NOWRAP><center>" & SQLArray(4, i) & "</center></TD><TD NOWRAP><center>" & SQLArray(5, i) & "</center></TD><TD NOWRAP><center>" & SQLArray(6, i) & "</center></TD><TD NOWRAP><center>" & SQLArray(7, i) & "</center></TD></TR>"
next
strResults = strBegin & strHead & strRows & "</TABLE>" 

oCon.Close
Set oRs = Nothing
Set oCon = Nothing

'send the email
sendemail "guy@blah.com", "guy@blah.com", "TESTING UAT Report for " & date, strResults

'Format Output
function fixStrLen(strValue, intLength)
   fixStrLen = left(strValue & space(intLength), intLength)
end function

Function Lpad (inputStr, padChar, lengthStr)  
    Lpad = string(lengthStr - Len(inputStr),padChar) & inputStr  
End Function

'Send email notification function
function sendEmail (strTo, strFrom, strSubject, strBody)
   set objEmail = CreateObject("CDO.Message")
   objEmail.From = strFrom
   objEmail.To = strTo
   objEmail.Subject = strSubject
   objEmail.HTMLBody = strBody
   objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/sendusing")[/URL] = 2
   objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserver")[/URL] = "<servername>"
   objEmail.Configuration.Fields.Item ("[URL unfurl="true"]http://schemas.microsoft.com/cdo/configuration/smtpserverport")[/URL] = 25
   objEmail.Configuration.Fields.Update
   objEmail.Send
end function

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Allow for more or less data 1

Shelby500

IS-IT--Management

Geates

Programmer

Shelby500

IS-IT--Management

Shelby500

IS-IT--Management

Geates

Programmer

Shelby500

IS-IT--Management

guitarzan

Programmer

Shelby500

IS-IT--Management

Shelby500

IS-IT--Management

Shelby500

IS-IT--Management

PHV

MIS

Shelby500

IS-IT--Management

Shelby500

IS-IT--Management

PHV

MIS

Shelby500

IS-IT--Management

Similar threads

Part and Inventory Search

Sponsor