Login  | |
|
 |
RE: VbScript help for PDF - 1/8/2008 2:42:29 AM
|
|
 |
|
| |
ashok_ganeshs
Posts: 92
Score: 0
Joined: 12/5/2006
Status: offline
|
Thanks ebgreen,not sure which post is that,but luckily i copied the code on the other day...here you go
Option Explicit
' ##### Globals
Const ForAppending = 8
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
' ##### Choose function of current interest
WScript.Quit doMain()
' ##### main functions
Function doMain()
WScript.Echo "stefgr::doMain - (nothing) done (yet)."
doMain = 0
End Function
' ##### utility functions
' ##### Globals
+++ Const ForAppending = 8
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
+++ Dim goLog : Set goLog = goFS.OpenTextFile( ".\stefgr.log", ForAppending, True )
' ##### Choose function of current interest
+++ WScript.Quit doMain2()
WScript.Quit doMain()
Sub Log( sMsg )
WScript.Echo sMsg
goLog.WriteLine Now() & " " & sMsg
End Sub
' ##### utility functions
' get open ADODB.Connection to .XLS file or die
Function getXLS( sXslFSpec )
' for more elaborate connections strings see
' http://www.connectionstrings.com
Dim oCN : Set oCN = CreateObject( "ADODB.Connection" )
Dim sCS : sCS = Join( Array( _
"Provider=Microsoft.Jet.OLEDB.4.0" _
, "Data Source=" & goFS.GetAbsolutePathName( sXslFSpec ) _
, "Extended Properties=""Excel 8.0;HDR=YES;MAXSCANROWS=1""" _
), ";" )
' for more elaborate operations see ado<NN>.chm
oCN.Open sCS
Set getXLS = oCN
End Function
' get open ADODB.Connection (TEXT) to current directory or die
Function getTXT()
Dim oCN : Set oCN = CreateObject( "ADODB.Connection" )
Dim sCS : sCS = Join( Array( _
"Provider=MSDASQL.1" _
, "Driver={Microsoft Text Driver (*.txt; *.csv)}" _
, "DBQ=" & goFS.GetAbsolutePathName( ".\" ) _
), ";" )
oCN.Open sCS
Set getTXT = oCN
End Function
' poor man's grid display
Function doMain2()
Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
Log "connect to xls."
Dim cnTXT : Set cnTXT = getTXT()
Log "connect to txt."
cnTXT.Close
Log "xls closed."
cnMSS.Close
Log "txt closed."
WScript.Echo "stefgr::doMain2 - open/close connections."
doMain2 = 0
End Function
C:\wis\_vbs\0506\dev\forum\stefgr
cscript stefgr.vbs
connect to xls.
connect to txt.
xls closed.
txt closed.
stefgr::doMain2 - open/close connections.
C:\wis\_vbs\0506\dev\forum\stefgr
type stefgr.log
19.12.2007 14:39:53 connect to xls.
19.12.2007 14:39:53 connect to txt.
19.12.2007 14:39:53 xls closed.
19.12.2007 14:39:53 txt closed.
Option Explicit
' ##### Globals
Const ForAppending = 8
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
Dim goLog : Set goLog = goFS.OpenTextFile( ".\stefgr.log", ForAppending, True )
' ##### Choose function of current interest
WScript.Quit frsLook()
WScript.Quit doMain2()
WScript.Quit doMain()
' ##### main functions
Function frsLook()
Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
Dim sSQL : sSQL = "SELECT * FROM [Sheet1$]"
Dim oRS : Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
cnMSS.Close
WScript.Echo "stefgr::frsLook - access sheet as table."
frsLook = 0
End Function
Function doMain2()
Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
Log "connect to xls."
Dim cnTXT : Set cnTXT = getTXT()
Log "connect to txt."
cnTXT.Close
Log "xls closed."
cnMSS.Close
Log "txt closed."
WScript.Echo "stefgr::doMain2 - open/close connections."
doMain2 = 0
End Function
Function doMain()
WScript.Echo "stefgr::doMain - (nothing) done (yet)."
doMain = 0
End Function
' ##### utility functions
' get open ADODB.Connection to .XLS file or die
Function getXLS( sXslFSpec )
' for more elaborate connections strings see
' http://www.connectionstrings.com
Dim oCN : Set oCN = CreateObject( "ADODB.Connection" )
Dim sCS : sCS = Join( Array( _
"Provider=Microsoft.Jet.OLEDB.4.0" _
, "Data Source=" & goFS.GetAbsolutePathName( sXslFSpec ) _
, "Extended Properties=""Excel 8.0;HDR=YES;MAXSCANROWS=1""" _
), ";" )
' for more elaborate operations see ado<NN>.chm
oCN.Open sCS
Set getXLS = oCN
End Function
' get open ADODB.Connection (TEXT) to current directory or die
Function getTXT()
Dim oCN : Set oCN = CreateObject( "ADODB.Connection" )
Dim sCS : sCS = Join( Array( _
"Provider=MSDASQL.1" _
, "Driver={Microsoft Text Driver (*.txt; *.csv)}" _
, "DBQ=" & goFS.GetAbsolutePathName( ".\" ) _
), ";" )
oCN.Open sCS
Set getTXT = oCN
End Function
' poor man's grid display
Sub showRS( oRS )
Const adClipString = 2 ' to keep ADO happy
Dim sHead : sHead = ""
Dim oFld
For Each oFld In oRS.Fields
sHead = sHead & vbTab & oFld.Name
Next
' to cope with empty recordsets
Dim sData
If oRS.EOF Then sData = "no data" & vbCrLf Else sData = oRS.GetString( adClipString, , vbTab, vbCrLf, "NULL" )
WScript.Echo Join( Array( _
String( 70, "=" ) _
, vbCrLf _
, oRS.Source _
, vbCrLf _
, Mid( sHead, 2 ) _
, vbCrLf _
, String( 70, "-" ) _
, vbCrLf _
, sData _
, String( 70, "=" ) _
), "" )
End Sub
' reduce whitespace in SQL (dangerous!)
Function cleanSQL( sSQL )
Dim oRE : Set oRE = New RegExp
oRE.Global = True
oRE.Pattern = "\s+"
cleanSQL = oRE.Replace( sSQL, " " )
End Function
' poor man's Log4VBScript
Sub Log( sMsg )
WScript.Echo sMsg
goLog.WriteLine Now() & " " & sMsg
End Sub
C:\wis\_vbs\0506\dev\forum\stefgr
cscript stefgr.vbs
======================================================================
SELECT * FROM [Sheet1$]
F1 Surname Name Course Absences' Limit Total Absences Excused Absences Unexcused Absences 3rd Phone
----------------------------------------------------------------------
1 APOSTOLIDIS FOIVOS CIS-787174A - DATABASE SYSTEMS 6 10 NULL 10 6945757419
2 BINTELAS ELEFTHERIOS COMM-782004A - COMMUNICATIONS ANALYSIS 6 15 NULL 15 6932445984
NULL NULL NULL COMM-782154A - INFORMATION GATHERING & REPORTING 6 7 NULL 7 Null
NULL NULL NULL COMM-782154A - INFORMATION GATHERING & REPORTING 6 7 NULL 7 Null
3 APOSTOLIDIS FOIVOS CIS-787174A - DATABASE SYSTEMS 6 10 NULL 10 6945757419
NULL NULL NULL IUKB4 - GLOBAL MARKETING 9 10 NULL 10 Null
NULL RASHKOVA MELINA IUKB20 - ACCOUNTING 9 11 NULL 11 6981752219
[...]
NULL NULL NULL H-C15 - VISUAL PROGRAMMING 9 14 NULL 14 Null
NULL NULL NULL H-C28 - NETWORKING TECHNOLOGY 9 13 NULL 13 Null
NULL TZANES KALLIOPI H-C14 - DATA ANALYSIS & DATABASE DESIGN 9 21 NULL 21 6932488676
NULL NULL NULL H-C15 - VISUAL PROGRAMMING 9 14 NULL 14 Null
NULL NULL NULL H-C28 - NETWORKING TECHNOLOGY 9 18 NULL 18 Null
NULL GEROYLANOY E?ATERINI APC308 - FINANCIAL MANAGEMENT 9 12 NULL 12 6937084124
NULL KUMANI RENALD SIM366 - STRATEGIC MANAGEMENT 9 10 NULL 10 6947228118
NULL XELIOTI KATERINA APC308 - FINANCIAL MANAGEMENT 9 15 NULL 15 Null
NULL NULL NULL SIM366 - STRATEGIC MANAGEMENT 9 12 NULL 12 Null
NULL S????? 1 NULL NULL NULL NULL NULL NULL Null
======================================================================
stefgr::frsLook - access sheet as table.
C:\wis\_vbs\0506\dev\forum\stefgr
cscript stefgr.vbs
======================================================================
SELECT * FROM [Sheet1$]
F1 Surname FrsName Course AbsLimit AbsTotal AbsExcused AbsNotExcused Phone3
----------------------------------------------------------------------
1 APOSTOLIDIS FOIVOS CIS-787174A - DATABASE SYSTEMS 6 10 NULL 10 6945757419
2 BINTELAS ELEFTHERIOS COMM-782004A - COMMUNICATIONS ANALYSIS 6 15 NULL 15 6932445984
NULL NULL NULL COMM-782154A - INFORMATION GATHERING & REPORTING 6 7 NULL 7 Null
NULL NULL NULL COMM-782154A - INFORMATION GATHERING & REPORTING 6 7 NULL 7 Null
[...]
NULL GEROYLANOY E?ATERINI APC308 - FINANCIAL MANAGEMENT 9 12 NULL 12 6937084124
NULL KUMANI RENALD SIM366 - STRATEGIC MANAGEMENT 9 10 NULL 10 6947228118
NULL XELIOTI KATERINA APC308 - FINANCIAL MANAGEMENT 9 15 NULL 15 Null
NULL NULL NULL SIM366 - STRATEGIC MANAGEMENT 9 12 NULL 12 Null
======================================================================
stefgr::frsLook - access sheet as table.
Function showPC()
Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
Dim sSQL, oRS
sSQL = Join( Array( _
"SELECT DISTINCT Surname, FrsName, Phone3" _
, "FROM [Sheet1$]" _
, "WHERE Surname IS NOT NULL" _
, "ORDER BY Surname DESC" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
sSQL = Join( Array( _
"SELECT DISTINCT Course" _
, "FROM [Sheet1$]" _
, "WHERE Course IS NOT NULL" _
, "ORDER BY Course" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
cnMSS.Close
WScript.Echo "stefgr::showPC - show users/courses."
showPC = 0
End Function
Function showPCHTML()
Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
Dim sSQL, oRS
sSQL = Join( Array( _
"SELECT DISTINCT SurName, FrsName, Phone3" _
, "FROM [Sheet1$]" _
, "WHERE Surname IS NOT NULL" _
, "ORDER BY Surname DESC" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRSHTML "persons.html", oRS
oRS.Close
sSQL = Join( Array( _
"SELECT DISTINCT Trim( Course ) AS Course" _
, "FROM [Sheet1$]" _
, "WHERE Course IS NOT NULL AND '' <> Trim( Course )" _
, "ORDER BY Trim( Course )" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
' showRSHTML "courses.html", oRS
oRS.Close
cnMSS.Close
WScript.Echo "stefgr::showPCHTML - show persons/courses using HTML."
showPCHTML = 0
End Function
' poor man's HTML display
Sub showRSHTML( sFiNa, oRS )
Const adClipString = 2 ' to keep ADO happy
Dim sName : sName = goFS.GetFileName( sFiNa )
Dim sFSpec : sFSpec = goFS.GetAbsolutePathName( sFiNa )
Dim sHead : sHead = ""
Dim sHTML : sHTML = Join( Array( _
"<html>" _
, " <head>" _
, " <title>" & sName & "</title>" _
, " </head>" _
, " <body>" _
, " <table border = '1' summary = '" & sName & "'>" _
, " <tr>" _
, " @Head@" _
, " </tr>" _
, " @Data@" _
, " </table>" _
, " </body>" _
, "</html>" _
), vbCrLf )
Dim oFld
For Each oFld In oRS.Fields
sHead = sHead & "<th>" & oFld.Name & "</th>"
Next
' to cope with empty recordsets
Dim sData
If oRS.EOF Then
sData = "<tr><td>no data</td></tr>"
Else
sData = "<tr><td>" _
& oRS.GetString( adClipString, , "</td><td>", "</td></tr>" & vbCrLf & " <tr><td>", "NULL" ) _
& " </td></tr>"
End If
sHTML = Replace( sHTML, "@Head@", sHead )
sHTML = Replace( sHTML, "@Data@", sData )
sHTML = Replace( sHTML, "&" , "&" ) ' more work to do!
goFS.CreateTextFile( sFSpec, True ).Write sHTML
End Sub
sSQL = Join( Array( _
"SELECT FrsName" _
, "FROM [Sheet1$]" _
, "WHERE FrsName IS NOT NULL" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
' showRSHTML "persons.html", oRS
Do Until oRS.EOF
WScript.Echo oRS( "FrsName" ).Value
goLog.WriteLine oRS( "FrsName" ).Value
oRS.MoveNext
Loop
oRS.Close
Function SimpleQueries()
Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
Dim sSQL, oRS
sSQL = Join( Array( _
"SELECT SurName, FrsName" _
, "FROM [Sheet1$]" _
, "WHERE Surname IS NOT NULL AND Phone3 IS NULL" _
, "ORDER BY Surname, FrsName" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
sSQL = Join( Array( _
"SELECT SurName" _
, "FROM [Sheet1$]" _
, "WHERE Surname IS NOT NULL AND FrsName IS NULL" _
, "ORDER BY Surname" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
sSQL = Join( Array( _
"SELECT SurName, FrsName" _
, "FROM [Sheet1$]" _
, "WHERE Surname IS NOT NULL AND 'A' = Left( FrsName, 1 )" _
, "ORDER BY FrsName" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
sSQL = Join( Array( _
"SELECT SurName, FrsName" _
, "FROM [Sheet1$]" _
, "WHERE Surname IS NOT NULL AND Left( FrsName, 1 ) IN ( 'A', 'E', 'O' )" _
, "ORDER BY FrsName" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
Dim aNumbers : aNumbers = Array( "AbsLimit", "AbsTotal", "AbsExcused", "AbsNotExcused" )
Dim aFuncs : aFuncs = Array( "COUNT", "MIN", "MAX", "AVG" )
Dim sFld, sFunc, sTmp
sSQL = "SELECT @F@( @C@ ) FROM [Sheet1$] WHERE @C@ IS NOT NULL"
For Each sFld In aNumbers
For Each sFunc In aFuncs
sTmp = Replace( sSQL, "@F@", sFunc )
sTmp = Replace( sTmp, "@C@", sFld )
' WScript.Echo sTmp
Set oRS = cnMSS.Execute( sTmp )
WScript.Echo sFld, sFunc, oRS.Fields( 0 ).Value
oRS.Close
Next
WScript.Echo
Next
sSQL = Join( Array( _
"SELECT Surname, Phone3, AbsTotal, AbsNotExcused" _
, "FROM [Sheet1$]" _
, "WHERE AbsTotal<> AbsNotExcused" _
), " " )
Set oRS = cnMSS.Execute( sSQL )
showRS oRS
oRS.Close
cnMSS.Close
WScript.Echo "stefgr::SimpleQueries - show persons/courses using HTML."
SimpleQueries = 0
End Function
|
|
| |
|
|
|
|
RE: VbScript help for PDF - 1/8/2008 2:51:38 AM
|
|
|
|
| |
ebgreen
Posts: 4972
Score: 31
Joined: 7/12/2005
Status: offline
|
Wow. that is one of ehvbs' larger ones. Perhaps for the time being we should forget about altering his code and simply use it to pick and choose the parts that you need. For instance, it looks like your code populates a recordset then you move to the beginning of the recordset but you don't do anything with the data in the recordset. Search the forum for .MoveNext. When you find that you will have found an example of doing something with every record in a recordset.
_____________________________
"... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
http://www.visualbasicscript.com/m_47117/tm.htm
|
|
| |
|
|
|
|
Printable Version
