RE: Excel and vbs

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

RE: Excel and vbs

Logged in as: Guest

arrSession:exec spGetSession 2,2,53851

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> WSH & Client Side VBScript >> RE: Excel and vbs
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: << < prev 1 2 3 [4]

Message

<< Older Topic Newer Topic >>

RE: Excel and vbs - 12/19/2007 3:42:08 AM

Stefgr

Posts: 24
Score: 0
Joined: 11/27/2007
Status: offline

Thanks is working great . Sorry about that , that i am asking all the time just want to check if the scipt will work and at the same time learn.
I want to ask if we want to merge the cell B C that is the surname and the name . i am think like that :

Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Const ForWriting = 2
Set objFile = objFSO.OpenTextFile("test.txt", ForWriting, True)
Dim ex, I, ID
Set ex = CreateObject("Excel.Application")
ex.Workbooks.Open "C:\Log1.xls"    'Open file
bGetData = False
bUserNotFound = True
With ex.ActiveSheet
For I = 1 To ex.ActiveSheet.UsedRange.Rows.Count
If (ex.ActiveSheet.Range("B"+"C" & I).Value = "SACHLAS NIKOS" And ex.ActiveSheet.Range("I" & I).Value = "6945757417") Or (bGetData And ex.ActiveSheet.Range("B" & I).Value = "") Then
IDD = ex.ActiveSheet.Range("D" & I).Value
IDE = ex.ActiveSheet.Range("E" & I).Value
IDF = ex.ActiveSheet.Range("F" & I).Value
IDG = ex.ActiveSheet.Range("G" & I).Value
IDH = ex.ActiveSheet.Range("H" & I).Value
objfile.WriteLine "Course : " & IDD & " Absences' Limit : " & IDE & " Total Absences : " & IDF & " Excused Absences : " & IDG & " Unexcused Absences : " & IDH
bGetData = True
bUserNotFound = False
Else
bGetData = False
End if
Next
End With
If bUserNotFound Then
objfile.WriteLine " Data Not Found."
End If
objFile.Close
ex.Quit
WScript.Quit

I am changed the If (ex.ActiveSheet.Range("B"+"C" & I).Value = "SACHLAS NIKOS"     (so we will not have seperate surname and name) but i am getting the Data Not Found."

(in reply to ebgreen)

Post #: 61

RE: Excel and vbs - 12/19/2007 3:48:49 AM

ebgreen

Posts: 4595
Score: 29
Joined: 7/12/2005
Status: offline

try changing this:

If (ex.ActiveSheet.Range("B"+"C" & I).Value = "SACHLAS NIKOS"

to this:

If (ex.ActiveSheet.Range("B" & I).Value & " " & (ex.ActiveSheet.Range("C" & I).Value = "SACHLAS NIKOS"

_____________________________

"... 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

(in reply to Stefgr)

Post #: 62

RE: Excel and vbs - 12/19/2007 3:58:41 AM

Stefgr

Posts: 24
Score: 0
Joined: 11/27/2007
Status: offline

i tried this :

Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Const ForWriting = 2
Set objFile = objFSO.OpenTextFile("test.txt", ForWriting, True)
Dim ex, I, ID
Set ex = CreateObject("Excel.Application")
ex.Workbooks.Open "C:\Log1.xls"    'Open file
bGetData = False
bUserNotFound = True
With ex.ActiveSheet
For I = 1 To ex.ActiveSheet.UsedRange.Rows.Count
If (ex.ActiveSheet.Range("B" & I).Value & " " & ex.ActiveSheet.Range("C" & I).Value = "APOSTOLIDIS FOIVOS" And ex.ActiveSheet.Range("I" & I).Value = "6945757417") Or (bGetData And ex.ActiveSheet.Range("B" & I).Value = "") Then
IDD = ex.ActiveSheet.Range("D" & I).Value
IDE = ex.ActiveSheet.Range("E" & I).Value
IDF = ex.ActiveSheet.Range("F" & I).Value
IDG = ex.ActiveSheet.Range("G" & I).Value
IDH = ex.ActiveSheet.Range("H" & I).Value
objfile.WriteLine "Course : " & IDD & " Absences' Limit : " & IDE & " Total Absences : " & IDF & " Excused Absences : " & IDG & " Unexcused Absences : " & IDH
bGetData = True
bUserNotFound = False
Else
bGetData = False
End if
Next
End With
If bUserNotFound Then
objfile.WriteLine " Data Not Found."
End If
objFile.Close
ex.Quit
WScript.Quit

You said : If (ex.ActiveSheet.Range("B" & I).Value & " " & (ex.ActiveSheet.Range("C" & I).Value = "SACHLAS NIKOS"    but there was an error then i remove the ( from (ex.ActiveSheet.Range("C" & I).Value = "SACHLAS NIKOS"

Its working perfect :)

< Message edited by Stefgr -- 12/19/2007 4:01:09 AM >

(in reply to ebgreen)

Post #: 63

RE: Excel and vbs - 12/19/2007 4:03:27 AM

ebgreen

Posts: 4595
Score: 29
Joined: 7/12/2005
Status: offline

Good...glad it is working.

_____________________________

"... 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

(in reply to Stefgr)

Post #: 64

RE: Excel and vbs - 12/19/2007 4:07:10 AM

Stefgr

Posts: 24
Score: 0
Joined: 11/27/2007
Status: offline

Thank you very much ! i will do some test tommorow and i will post here.
Thanks again.

(in reply to ebgreen)

Post #: 65

RE: Excel and vbs - 12/19/2007 7:37:14 AM

ehvbs

Posts: 2012
Score: 48
Joined: 6/22/2005
From: Germany
Status: offline

Hi all,

having followed this discussion with the feeling that there should be another possible approach
(less Excel and more database/SQL), but afraid of disturbing the flow to what now looks like a
workable solution, I now think another of my monster posts can't hurt (Stefgr is in good hands
and doesn't need even to look at this). Furthermore as the holidays are coming somebody may
become under-worked ....

Let's treat this problem as a step by step project.

It's a project so:

Create a new directory somewhere (I called mine "stefgr", because before
thinking about the problem I couldn't come up with a more descriptive
name

Create a new text file (stefgr.notes) to collect all relevant info using a
free form (you are reading a part of my .notes file just now)

Download the "total_abs_list.xls" file to \stefgr; copy it to "total_abs_list.org.xls "
(then you can look at 'it' with Excel, while accessing 'it' from the script)

Create a new .vbs file (stefgr.vbs) containing


run it; expected output:


Now you can tell your boos, that the program terminates successfully.

First we need a ADO database connection to "total_abs_list.xls"; let's throw
in a simple logging facility and a ADO connection to text files as well.

For the Log we need a file to append to: add



at the top, and


at the end.

To access an ADO database of a specific kind, we have to create a ADO connection
and open this with a database type specific connections string. Read all about
connection strings at

       http://www.connectionstrings.com

Add these functions:

' ##### 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

Perhaps you'll have to change "Excel 8.0" to "Excel 9.0" or whatever to suit
your computer.

To see what we have done, add a new main function:


run stefgr.vbs; expected output:



Now the time has come to look at the data; for that we need a new main
function (frsLook) that does some SQL to ".\total_abs_list.xls" and a utility
Sub (showRS) that displays the result set of a SELECT statement. After these
additions the file should look like:

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

' for more elaborate operations see ado<NN>.chm
 oCN.Open sCS
 Set getXLS = 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

expected output:

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.

The column names are not so good and the last row doesn't belong to the data. Let's
do something drastic and change/delete these inconveniencies (now you see, why it
is a good idea to keep .org. copies).

Output after these arrangements:

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.

For a more orderly view at the data, let's concentrate on the persons (Surname,FrsName,Phone3)
and the courses (Course). The new main function is:



You can use this function as a template/frame to experiment with SQL SELECT
statements. But the output is for hard core programmers only, not for users/bosses.
So let's create HTML output. New main function:


supported by this utility 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, "&"     , "&amp;" ) ' more work to do!

goFS.CreateTextFile( sFSpec, True ).Write sHTML

End Sub

Writing this, I was confronted with a nasty problem: The

goFS.CreateTextFile( sFSpec, True ).Write sHTML

line caused an "bad args or params error". It took me some time to understand: Converting
the UNICODE VBScript strings to ASCII/ANSI/WindowsCodepageEncoding the poor IO-System
found some characters it couldn't handle. Instead of plainly stating this fact it blamed
my wonderful HTML string.
The Surname "KRITSOPI" and the FrsNames "CLAUDIA-ANDREEA" and "EKATERINI" contained
funny greek letters that couldn't be handled by my computer/locale (it can only do german
funny letters).

I used code like:

to find the culprits and changed them. (Such problems can be avoided by dealing in
UNICODE only, but if you are programming for your cultural context this better
principle isn't often adhered to.)

Now Stefgr is interested in queries/reports. Let's do some simple examples:

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

output:


E.g. how about this:



For the more interesting queries concerning persons and their time, the gaps in table
must be filled. Though this could be done automagically, I will do it on a manually
created copy of sheet1 to sheet2 to save time (and explanations). So use Excel to
copy sheet1 to a new sheet2 in "total_abs_list.xls". Furthermore, delete the (mostly)
empty column A. Cautious people may copy this changed table to Sheet3 - you never know.

The new code is straightforwards:



Open the connection, open the recordset (not in the default (read-only, forwards)
mode suited to display, but modifiable. Get the good data from the first line.
Loop over the rows (no ActiveExec.Range( x - y * z ).Friday.AllSelected here).
If a value is missing the the last good one, else store the nice data for later.
[At last I hope so.] To check with (Stefgr's) naked eye:



From this there is just a small step to a full report:

Function fullReport()
 Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
 Dim sSQL, oRS

sSQL    = Join( Array( _
             "SELECT Surname, FrsName, Course," _
           , "SUM( AbsLimit ) AS ALimit, SUM( AbsTotal ) AS ATotal, Sum( AbsNotExcused ) AS ANex" _
           , "FROM [Sheet2$]" _
           , "GROUP BY Surname, FrsName, Course" _
           , "ORDER BY Surname, FrsName, Course" _
                      ), " " )
 Set oRS = cnMSS.Execute( sSQL )
 showRSHTML "fullreportpc.html", oRS
 oRS.Close

sSQL    = Join( Array( _
             "SELECT Course, Surname, FrsName," _
           , "SUM( AbsLimit ) AS ALimit, SUM( AbsTotal ) AS ATotal, Sum( AbsNotExcused ) AS ANex" _
           , "FROM [Sheet2$]" _
           , "GROUP BY Course, Surname, FrsName" _
           , "ORDER BY Course, Surname, FrsName" _
                      ), " " )
 Set oRS = cnMSS.Execute( sSQL )
 showRSHTML "fullreportcp.html", oRS
 oRS.Close

WScript.Echo "stefgr::fullReport - show grouped data using HTML."
 fullReport = 0
End Function

The SQL may seem complex, but the code gets repetitive. As I don't understand Stefgr's
informational problem/need(s) well, I won't add further queries haphazardly, but the
technique is demonstrated by:

Function dirtyDetails()
 Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
 Dim sSQL, oRS

sSQL    = Join( Array( _
             "SELECT DISTINCT Course, FrsName + ' ' + Surname" _
           , "FROM [Sheet2$]" _
           , "WHERE 'ZOI' = Surname" _
                      ), " " )
 Set oRS = cnMSS.Execute( sSQL )
 showRS oRS
 oRS.Close

sSQL    = Join( Array( _
             "SELECT Surname, FrsName, Course," _
           , "SUM( AbsTotal ) AS ATotal, Sum( AbsNotExcused ) AS ANex" _
           , "FROM [Sheet2$]" _
           , "GROUP BY Surname, FrsName, Course" _
           , "HAVING SUM( AbsTotal ) <> Sum( AbsNotExcused )" _
                      ), " " )
 Set oRS = cnMSS.Execute( sSQL )
 showRS oRS
 oRS.Close

sSQL    = Join( Array( _
             "SELECT *" _
           , "FROM [Sheet2$]" _
           , "WHERE 'DESIPRI' = Surname AND 'NY 611101 - COMPOSITION I' = Course" _
                      ), " " )
 Set oRS = cnMSS.Execute( sSQL )
 showRSHTML "DESIPRI.html", oRS
 oRS.Close

WScript.Echo "stefgr::dirtyDetails - some dirty details."
 dirtyDetails = 0
End Function

Now the full script as it is at the moment:

Option Explicit

' ##### Globals

Const ForReading   = 2
Const ForWriting   = 2
Const ForAppending = 8

Const adOpenForwardOnly =          0 ' 00000000
Const adOpenKeyset      =          1 ' 00000001
Const adOpenDynamic     =          2 ' 00000002
Const adOpenStatic      =          3 ' 00000003

Const adLockReadOnly        =          1 ' 00000001
Const adLockPessimistic     =          2 ' 00000002
Const adLockOptimistic      =          3 ' 00000003
Const adLockBatchOptimistic =          4 ' 00000004

Dim goFS  : Set goFS  = CreateObject( "Scripting.FileSystemObject" )
Dim goLog : Set goLog = goFS.OpenTextFile( ".\stefgr.log", ForAppending, True )

' ##### Choose function of current interest

WScript.Quit dirtyDetails()
WScript.Quit fullReport()
WScript.Quit secLook()
WScript.Quit fillGaps()
WScript.Quit SimpleQueries()
WScript.Quit showPCHTML()
WScript.Quit showPC()
WScript.Quit frsLook()
WScript.Quit doMain2()
WScript.Quit doMain()

' ##### main functions

Function dirtyDetails()
 Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
 Dim sSQL, oRS

WScript.Echo "stefgr::dirtyDetails - some dirty details."
 dirtyDetails = 0
End Function

Function fullReport()
 Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
 Dim sSQL, oRS

WScript.Echo "stefgr::fullReport - show grouped data using HTML."
 fullReport = 0
End Function

Function secLook()
 Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
 Dim sSQL, oRS

sSQL    = Join( Array( _
             "SELECT * " _
           , "FROM [Sheet2$]" _
           , "ORDER BY Surname, FrsName" _
                      ), " " )
 Set oRS = cnMSS.Execute( sSQL )
 showRSHTML "allnogaps.html", oRS
 oRS.Close

WScript.Echo "stefgr::secLook - show filled table using HTML."
 secLook = 0
End Function

Function fillGaps()
 Dim cnMSS : Set cnMSS = getXLS( ".\total_abs_list.xls" )
 Dim sSQL, oRS

sSQL = "SELECT * FROM [Sheet2$]"
 Set oRS = CreateObject( "ADODB.Recordset" )
 oRS.Open sSQL, cnMSS, adOpenStatic, adLockOptimistic
 ' the first row is ok
 Dim sSurName : sSurName = oRS( "Surname" ).Value
 Dim sFrsName : sFrsName = oRS( "FrsName" ).Value
 Dim sPhone3  : sPhone3  = oRS( "Phone3"  ).Value
 Do Until oRS.EOF
    If IsNull( oRS( "Surname" ).Value ) Then
       oRS( "Surname" ).Value = sSurName
    Else
       sSurName = oRS( "Surname" ).Value
    End If
    If IsNull( oRS( "FrsName" ).Value ) Then
       oRS( "FrsName" ).Value = sFrsName
    Else
       sFrsName = oRS( "FrsName" ).Value
    End If
    If IsNull( oRS( "Phone3" ).Value ) Then
       oRS( "Phone3" ).Value = sPhone3
    Else
       sPhone3 = oRS( "Phone3" ).Value
    End If
    oRS.Update
    oRS.MoveNext
 Loop

WScript.Echo "stefgr::fillGaps - fill the gaps."
 fillGaps = 0
End Function

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 Left( FrsName, 1 ) IN ( 'A', 'E', 'O' )" _
           , "ORDER BY FrsName" _
                      ), " " )
 Set oRS = cnMSS.Execute( sSQL )
 showRS oRS
 oRS.Close

cnMSS.Close
 WScript.Echo "stefgr::SimpleQueries - show persons/courses using HTML."
 SimpleQueries = 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

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 persons/courses."
 showPC = 0
End Function

Function doMain()
 WScript.Echo "stefgr::doMain - (nothing) done (yet)."
 doMain = 0
End Function

' ##### utility functions

' for more elaborate operations see ado<NN>.chm
 oCN.Open sCS
 Set getXLS = oCN
End Function

goFS.CreateTextFile( sFSpec, True ).Write sHTML

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

I'm sure that if you work thru this (reading about ADO in ado<NN>.chm (ado28.chm
probably)) and about SQL in a good book (SQL in a Nutshell) or an online tutorial
- http://sqlzoo.net/) you'll aquire reusable skills/knowledge in an efficient
way. Feel free to ask and/or describe your information processing pet project
to let us all see, if the technique/code base is really as extensible/reusable
as I claim.

[disclaimer: Christmas is coming and I may not be able to spend as much time here
as necessary for quick responses]

Speaking of Christmas: Merry Christmas & an error free new year to you all.

ehvbs

(in reply to Stefgr)

Post #: 66

RE: Excel and vbs - 12/19/2007 7:47:37 AM

ebgreen

Posts: 4595
Score: 29
Joined: 7/12/2005
Status: offline

Ehvbs, considering how much knowledge you have to share, it is a shame that you make your posts so terribly short. I think it would do the community a great deal of good if you could just open up and put just a little bit more information into your posts.

_____________________________

"... 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

(in reply to ehvbs)

Post #: 67

Page: << < prev 1 2 3 [4]

If you found our site useful please link to us <a href="http://www.visualbasicscript.com">VisualBasicScript.com</a>.

All Forums >> [Scripting] >> WSH & Client Side VBScript >> RE: Excel and vbs

Page: << < prev 1 2 3 [4]

Jump to: