Monday, October 14, 2013

excel addin subs called from vba

Hi,

SITUATION:
excel 2007, 2010, 2013
tested on excel 2013 only
compiled as any cpu
visual studio 2012 with office kit installed

PROBLEM:
We have too many subs in many excel sheets in our compagny
I am about to make some new subs for sharepoint 2013 and they need to be accessible for everyone
As you know vba cannot really access sharepoint 2013 client object model (yeah yeah i could call the DLL with all parameters, but, no thanks)

SOLUTION:
Program a excel addin and include the subs in it

PROBLEM:
you cannot simply call a sub in a addin from VBA
you need to go through a test first ;)

So here is my resulting code:

after you create a normal excel addin, you get:
Public Class ThisAddIn

    Private Sub ThisAddIn_Startup() Handles Me.Startup

    End Sub

    Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown

    End Sub

end class

Your addin project must be called "exceladdin1" for this code

Change the code of the addin for this to be able to call any sub in your addin from vba:
(with parameter in bonus)
note: the test sub is "shared" to be able to call it from the other class created to be able to be called from vba

'=== use addin sub in vba in excel

'=== call from VBA:
'Sub CallVSTOMethod()
'    Dim addIn As COMAddIn
'    Dim automationObject As Object
'    addIn = Application.COMAddIns("exceladdin1")
'    automationObject = addIn.Object
'    automationObject.ImportData("Hello world!")
'End Sub

'=== http://msdn.microsoft.com/en-us/library/vstudio/bb608614.aspx (video have the right code, demo have not it seems)
'=== video CallAddInFromVBA.wmv (working)

Imports System.Data
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel

<System.Runtime.InteropServices.ComVisibleAttribute(True)> _
<System.Runtime.InteropServices.InterfaceType(ComInterfaceType.InterfaceIsIDispatch)> _
Public Interface IAddInUtilities
    Sub ImportData(message As String)
End Interface


<System.Runtime.InteropServices.ComVisibleAttribute(True)> _
<System.Runtime.InteropServices.ClassInterface(System.Runtime.InteropServices.ClassInterfaceType.None)> _
Public Class AddInUtilities
    Implements IAddInUtilities

    ' This method tries to write a string to cell A1 in the active worksheet. 
    Public Sub ImportData(message As String) Implements IAddInUtilities.ImportData
        Call ThisAddIn.test(message)

    End Sub
End Class

Public Class ThisAddIn

    Private utilities As AddInUtilities

    Protected Overrides Function RequestComAddInAutomationService() As Object
        If utilities Is Nothing Then
            utilities = New AddInUtilities()
        End If
        Return utilities
    End Function

    Public Shared Sub test(message As String)
        MsgBox(message)
    End Sub
    '=== stas excel addin
    '=== made with visual studio 2010
    '=== debugged with excel 2013

    '=== this addin rearrange 2 sheet source display: database, notes
    '=== it generate a frame to enter data in it (bottom frame), sheet name: cartouche
    '=== it calculate the right width for database and notes columns to fill an A2 form with the notes and data
    '===
    '=== goal: make the final result PDF to be approvable by 4 poeple (numeric signatures)
    '=== goal: make final printed result usable in factory to adjust instruments settings for a machine


    Private Sub ThisAddIn_Startup() Handles Me.Startup

    End Sub

    Private Sub ThisAddIn_Shutdown() Handles Me.Shutdown

    End Sub

end class


now put that in your vba macro

---------------------- vba macro
'=== call from VBA:
Sub CallVSTOMethod()
    Dim addIn As COMAddIn
    Dim automationObject As Object
    addIn = Application.COMAddIns("exceladdin1")
    automationObject = addIn.Object
    automationObject.ImportData("Hello world!")
End Sub



Saturday, October 12, 2013

sharepoint 2013 copying files that have certain managed metadata terms to ntfs

Sharepoint 2013 - Visual studio 2012

SITUATION:
After migrating files to sharepoint and tagging them with managed metadata terms, our products are well managed. Every file needed to start a new project with a product model need approbation.

We have a site for each product, a document library for each product, and all our departements can work on the product itself before a new order (project) is processed.
So instead of starting a new order with an old order, we start it with a new product. That way, developpement and research can work on the product before we start a new order.

PROBLEM:
Unfortunatly, not all programs support sharepoint 2013 file access

So when a new order is started (new project or new submission) we copy all thoses files on a ntfs drive. Mainly because we have automation programs and cad software that does not support sharepoint 2013 web access very well.

Acrobat support the metadata terms tagging since 11.0.4, autocad does not. Webdav exist since a lot of years and is not yet supported by all software for accessing files. So i bet sharepoint with terms, will take about 20 years to be supported by all software.

Now when your managed metadata fields/columns in sharepoint are mandatory, you cannot even approve a document if the file was saved in sharepoint from a windows application that does not support sharepoint 2013, because the windows that ask you to enter the managed metadata does not pop up when the application does not support sharepoint. (office and acrobat have an activex that manage the save of the file to be able to choose the metadata while saving)

SOLUTION:
So programming such an active x to manage file saving for all the apllications in the world is too long for me. So I will simply put the new project in a normal windows ntfs file system when we start the new project.

I used the client object method to:
- query the main sharepoint site for products (http://sharepointsite/produits)
- query all the sub site (each sub site is a product)
- query all the documents library in each site (1 for each product)
- query the document library fields (columns) and extract the name of each column that use managed metadata
- present a list of choices to choose what product you want (sub site name, doc library name, metadata column name (must have same name as sub site)

Now the user choose: ACD (site name), Documents (library name), ACD (metadata fields with same name as site)

After that, i need to query the termstore to get sub product specification (type and number of rotors)
termstore:
- ACD
- RI
- ACD -- flux
- ACD -- type2
- ACD -- flux --- 4 rotors
- ACD -- flux --- 6 rotors

So i present the user with the second choice:
What type of ACD:
1 type01
2 type02
3 type03
4 type04

After this choice is made i get from the resultant term GUID the childrens terms from termstore
and present the third level of product choice:
type 02 was choosen
now choose sub specification:
1 2 rotors
2 4 rotors
3 6 rotors with stuff

I save the GUID of the 3 choices the user made in variables

Then i start scanning all the documents in the library that was choosen, in the site that was choosen

i also scanned the metadata field for all terms collections (multiple choices for each product)
Each document that have 1 of the 3 terms in the choices are selected to be copied in the new product
(in the managed metadata field of the document)

Note:
a document in sharepoint can now be tagger for ACD, type01, 4 rotor
if we make a new ACD we need the documents tagged ACD
if it's type01 we need the documents tagged type01
if a document is common for all type01, then we tag all sub terms (2 rotor, 4 rotor, 6 rotor)
etc.

I was told by many post on internet that this could not be done with client object model (COM) but it can.

PROBLEM:
the approved status of sharepoint is not very bright
if you show unnaproved files in your library, sharepoint will tell the file 3.1 is approved but it is not. only 3.0 is the right version
Now you can say hide unnaproved files, but the approver will still see then and the same problem come back

So i had to scan all version of all files to find last approved version by scanning the version number digits (3.1, i get version 3.0 url)

After that i asked kindly sharepoint to extract version 3.0 but it cannot be done
So i used the webclient to "download" the file with the version URL and it worked

Also, sharepoint was not always responding to a web query from client object model. So i had to use the timeout and make 3 request if neceesary, then a REAL error if all 3 request failed.

In short:
- choose product site, doc library that contain a metadata field that have the same name as site (this give term for product)
- ask termstore for subterms to make a sub choice
- choose product type (term)
- ask termstore for subterms to make a sub choice
- choose product sub type (number of rotors)
- scan files in the library
- scan terms fields of the file and choose every file that have one term common with any choice we made
- scan all version of the file and get URL of last major version (last approved version)
- download file and put it in a ntfs folder to start a new project

All this with COM (client object model) in a vb.net 2012 program running on computer client

Sorry i cannot post code here, it's a business project.
But i can gladly post some part of it if asked.



Monday, September 2, 2013

internet explorer 10 frame correction in web interface code

Hi,

I created a web interface to manage most of my vbs/wsh scripts

With the arrival of internet explorer 10, my frames were empty

So, in any of my script that use the web interface, change thoses lines:

set flef = oie.document.frames("left").document 
set fmid = oie.document.frames("middle").document 
set fbot = oie.document.frames("bottom").document

For these lines:

fileversion = objFSO.GetFileVersion("C:\program files\internet explorer\iexplore.exe")
finddot = instr(fileversion,".")
fileversion2 = left(fileversion,finddot-1)

if fileversion2 = "10" or fileversion2 = "11"  then
'=== ie10 frame access
set flef = oie.parent.document.getElementByid("left").contentdocument
set fmid = oie.parent.document.getElementByid("middle").contentdocument
set fbot = oie.parent.document.getElementByid("bottom").contentdocument
else
set flef = oie.document.frames("left").document
set fmid = oie.document.frames("middle").document
set fbot = oie.document.frames("bottom").document
end if



Saturday, May 11, 2013

recursiveness insertion in sql of an array made in vbs

recursiveness insertion in sql of an array made in vbs

the sub where the array is recursively scanned is SUB RETFOL

is will call itself each time the vbs array contain another array

it will create a new record in the sql database, related by a number to the precedent one

example:
array("test",array("subtest1","subtest2")

will give a record table in sql like this:
record 1 to 3:
id 1 - test
id 2 - subtest1 - idtoitself 1
id 3 - subtest2 - idtoitself 1


so the records related recursively to the main array are numbered to it

this script was originally created to manage folders creation

when security of ntfs started to be involved, i had to migrate the folder names to sql database for an easier management of wich security groups needed to have access to each folder



------------------------------- VBS code -------------------

'=== Ultimate dynamic web interface 2.0

'=== this script:
'=== generate dynamically a web interface to manage virtually anything
'=== control (left frame), input (middle frame), and output (bottom frame) from vbs/wsh (windows host scripts)

'=== the first version was a simple interface made by a programmer
'=== the second version have more explanations
'=== more dynamism than ever
'=== more functions to clean up main loop code
'=== easier array display coding to add stuff more easily
'=== MDB (access type database) management (creation, edition, search/edit)
'=== futur: mdb import, mdb export, sql sync, excel export

'=== by: SergeFournier(at)hotmail.com

'=== tested on windows vista 64, internet explorer 7

Set objFSO    = CreateObject("Scripting.FileSystemObject")
Set objshe    = CreateObject("WScript.Shell")
Set objNet    = CreateObject("WScript.Network") 

Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku  = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG

'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir  = left(thepath,p)
filnam = right(thepath,len(thepath)-p)

'=== windows dir
WinDir = objfso.GetSpecialFolder(0)

'=== restart the script in 32 bits if we are on a 64 bits system
'=== (databases drivers issues)
a64 = windir & "\syswow64\wscript.exe"

if objFSO.fileEXISTS(a64) and instr(lcase(wscript.fullname),"syswow64")=0 then
   '=== 64 bits system
   a = """" & a64 & """ """ & basedir & filnam & """"
   objshe.Run a,0, false
   wscript.quit
end if

Set objOutputFile = objfso.OpenTextFile(base_dir & "z_LDAP_to_sql_log_" & nom_table & ".txt", 2, true)
objOutputFile.WriteLine date & " " & time & " START"

'=== database
set tag = CreateObject ("ADODB.Recordset")
Set con_02 = CreateObject("ADODB.Connection")

'=== connexion serveur sql, sans se connecter sur une database
'=== MAIN SQL DATABASE CONNECTION
'con_02.ConnectionString = "Driver={SQL Server};Server=" & environ("stassql1") & ";Uid=sa;Pwd="
con_02.ConnectionString = "Driver={SQL Server};Server=sql.corp.stas.local"
con_02.connectiontimeout=500
con_02.Open

'=== DATABASE === sub creation

dbname = "224"

tabname = "folders_struct"

aracolnam = array( _ 
"nom", _ 
"parentfol", _ 
"permission", _ 
"categorie", _ 
"revision", _ 
"actif")

aratype = array( _ 
"varchar(255)", _ 
"int", _ 
"varchar(255)", _ 
"varchar(255)", _ 
"int", _ 
"int")

aracolunique = array()

call credb(dbname, tabname, aracolnam, aratype, aracolunique, objOutputFile, con_02, tag)


'============================================== main loop =============================================

'=== name of the user logged in window (network or not)
usenam=lcase(objnet.username)

'=== menu items on left side (control side, frame: flef)

'= arabutnam: name of button, purely programmation name, used later to execute functions in main loop
'= arabutdes: description of button, text inside it actually
'= aradepnam: departement name, each departement (Section) is separated by a space
'= aradepcol: color of departement, blue = computer, brown = accounting, etc will follow a standard on internet (vague)
   
'=== button at the start for control frame (flef object)
'=== you can add as many buttons as you want, it's all dynamic (extendable)

x=0
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="stasfolequ"
arabutdes(x)="STAS dossiers (equip. priv)"
aradepnam(x)="STAS"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="stasservice"
arabutdes(x)="STAS dossiers (service)"
aradepnam(x)="STAS"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="unigecfol"
arabutdes(x)="UNIGEC dossiers"
aradepnam(x)="UNIGEC"
aradepcol(x)="cccccc"

x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="quit01"
arabutdes(x)="Quitter"
aradepnam(x)="All"
aradepcol(x)="cccccc"

'=== print button
priara = array("<input type=""button"" onClick=""javascript:print()"" value=""Print""/><br><br>")

'=== i dont remember this one
lasdep=""
   
'=== web interface, internet explorer

'=== set the objects before calling functions, so they are global objects/variables, accessibles in all the program
set oIE = wscript.CreateObject("InternetExplorer.Application", "IE_")
dim flef, fmid, fbot

'=== title of internet explorer window
doctit = "titre de la page"

'=== title to display inside the left frame (control frame, flef object)
maitit = "SKYNET interface<br><br>STAS "'=== title inside the left frame

'=== create the main web interface with 3 frames, objects: flef, fmid, fbot
a = crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)

'=== defaut menu option for certain name logged
'=== example: a certain user will use always the same function
'=== so the interface will start, by executing this function at first, not an empty frame
'=== simply enter the name of the button that should be pressed for this user when interface start

if usenam="wildboy" or usenam="fournier.serge" then
   '=== defaut choice when program start
   'resbutlefstr = "stristas"
end if

'=== sub to call for each button
'=== here we define a sub to be called when a button in the web page is pressed
Do While (oIE.Busy)
   wscript.sleep 100
loop
do while oie.readystate<>4
   wscript.sleep 100
loop

'=== set up a return value on click of each button on the left frame
'=== the returned value is the name (programmable name) of each button (arabutnam)
'=== later any action will be taken according to this value
'=== i use this method because i dont want to call a sub when a button is pressed
'=== to remain in a loop for the main program, that is standard procedure in programming (to have a main loop)

for i=0 to ubound(arabutnam)
   flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
next

'=== we also chek the key presse in each frame
'=== we do this cause we want "enter" key to be used instead of pressing "ok" button with the mouse
set flef.onkeypress = GetRef("Checklef") 
set fmid.onkeypress = GetRef("Checkmid") 
set fbot.onkeypress = GetRef("Checkbot") 

'=== if bready = true, it mean they closed internet explorer, see the sub on internet explorer closing later in this code
'=== we have to chek this value often to stop the wscript.exe from interpreting this code, when internet explorer is closed
bReady=false
resbutlefstr = ""
resbutmidstr = ""
resbutbotstr = ""
reskeylef = 0
reskeymid = 0
reskeybot = 0

WScript.sleep(100) ' .1 seconds 

'=== main loop, infinite
'=== unless someone press QUIT button
'=== or close internet explorer (bready = true)

do                      

   '=== if the button named this is pressed we do this
   '=== resbutlefstr: result from pressing a button in the left frame (control frame, flef object)
   '=== its a string that contain the programmable name of the button that was pressed in the left frame (arabutnam)
   
   '=== 01 ====================== U N I G E C =============================
   
   if resbutlefstr="unigecfol" then
      
      a = clefra(array("fmid","fbot"))
   
   '=== 02 ================ folder generation in i drive

      ara01 = array( _ 
      "1 Communication", _ 
         array("01 Bordereau de transmission", "02 Clients", "03 Architectes", "05 Laboratoires", "04 Entrepreneurs", "06 Fournisseurs", "07 Internes",  "08 Autres"), _ 
      "2 Gestion Commerciale", _
         array("1 Offre de services","2 Facturation"), _
      "3 Gestion Projet", _ 
         array("1 Budget", "2 Échéancier", "3 Mandat","Cahier_de_projet"), _ 
      "4 Qualité", _ 
         array("1 Plan de qualité"), _ 
      "6 Devis", array( _ 
         "1 Pour soumission", _ 
         array("Autres", "Civil-structure", "Électricité", "Mécanique"), _ 
         "2 Pour construction", _ 
         array("Autres", "Civil-structure", "Électricité", "Mécanique"), _ 
         "3 Addenda", _ 
         array("Autres", "Civil-structure", "Électricité", "Mécanique"), _ 
         "4 Pour approbation", _ 
         array("Autres", "Civil-structure", "Électricité", "Mécanique")), _ 
      "7 Dessins Atelier", _ 
         array("1 Intrants", array("Autres","Civil-structure", "Électricité", "Mécanique"), _ 
               "2 Extrants", array("Autres","Civil-structure", "Électricité", "Mécanique")), _ 
      "5 Rapport", _ 
      "8 Technique", array( _ 
         "1 Intrants", _ 
            array("Autres", "Architectes", "Clients", "Entrepreneurs", "Fournisseurs", "Laboratoires Internes"), _ 
         "2 Calculs", _ 
            array("Civil-structure", "Électricité", "Mécanique"), _ 
         "3 Estimation des travaux", _ 
            array("Civil-structure", "Électricité", "Globale","Mécanique"), _ 
         "4 Extrants", array( _ 
            "Civil-structure", array("Pour construction", "Pour soumission", "Révisions antérieures"), _ 
            "Mécanique",       array("Pour construction", "Pour soumission", "Révisions antérieures"), _ 
            "Électricité",      array("Pour construction", "Pour soumission", "Révisions antérieures")), _ 
         "5 Extrants divers", _ 
         "6 Photos", array("Autres", "Civil-structure", "Électricité", "Mécanique")), _
      "9 Construction", array( _ 
         "1 Directives chantier", array("Civil-structure","Électricité","Mécanique"), _
         "2 Ordre de changement", array("Civil-structure","Électricité","Mécanique"), _ 
         "3 Certificats de paiement", _ 
         "4 Liste des déficiences", array("Civil-structure","Électricité","Mécanique"), _ 
         "5 Acceptation des travaux", _ 
         "6 Rapports quotidiens", _ 
         "7 Compte rendu réunions", _
         "8 Autres"))
   
   '=== 03 ===
      rap01=""
            
      for each a in priara
         rap01 = rap01 & a
      next      
      
      rap01 = rap01 & "<form name=form01>"
      rap01 = rap01 & "<b><table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 "
      rap01 = rap01 & "style='border-collapse:collapse;border:none'>"
      'rap01 = rap01 & "<CAPTION></CAPTION><span style='color:purple'>" & vbcrlf
      
      '=== ara01 = liste des dossiers, jagged array
      '=== con = contrat
      
      '=== HTML display
      sublvl=0
      tagsublvl=0
      lvl=1
      call retfol(ara01,"",0,"286_unigec",0)
      
      rap01=rap01 & "</table></form>"
      
      '=== write all the folder structure in bottom frame
      fbot.WriteLn(rap01)
      
      '=== 04 ===
      
      x=0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Code du contrat"             '===== description displayed in front of the field
      namtmp(x)="text01"                      '===== name of variable for programming purpose
      deftmp(x)=""                            '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
      typtmp(x)="textbox"                     '===== type of data: textbox password (futur: more to come)
      errtmp(x)="###%% (### = client %% = contrat"     '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      buttmp=array("ok","cancel")             '===== at the end, there will be an "ok" button and a "cancel" button
      tit = "UNIGEC - Structure dossier"
      a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
      
      do
         '=== flag to tell if the input is not valid
         err01=0
         '=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
         inpdon=0
         '=== "ok" button or "enter" key are the same
         '=== and nothing was pressed on left frame (control frame)
         
         if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then 
            '=== User has clicked the OK button, retrieve the values
            text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

            if len(text) < 5 then
               err01=1
               '=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
               if len(text) < 5 then
                  errtmp(0)="error - must be 5 char long at least"
               else 
                  errtmp(0)="ok"
               end if

               '=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
               a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
               '=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
               reskeymid=0
               resbutmidstr=""
            else
               '=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
               inpdon=1
               err01=0
            end if
         end if
         wscript.sleep 100
      
         '=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
         if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
            '=== if user pressed escape or cancel, we clear the frames
            if resbutmidstr="cancel" or reskeymid=27 then
               a = clefra(array("fmid","fbot"))
               resbutmidstr="cancel"
            end if
            exit do
         end if
      '=== if there was an input error and no one used left control frame to exit, we keep asking for input
      loop while err01<>0 or inpdon=0
      
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
         
         reskeymid=0
         resbutmidstr=""
         
         '=== cli = client number
         '=== con = contrat number
         '=== pat = path server and client and contrat
         
         '=== create basic folders I K S exchange
         cli=ucase(mid(text,1,3))
         con=ucase(right(text,len(text)-3))
         
         '=== b = path du i projets
         b = crebasfol(cli,con)
         
         '=== create all sub folders (pat is not empty so we create folders)
         
         newfol = 0
         dejfol = 0
         errfol = 0
         pattot = 0
         arapat=array(pat)
         pat = b
         
         '=== get parent folder id (id of last row in database)
         
         sql = "SELECT id FROM [224].dbo.[folders_Struct] WHERE (id = (SELECT MAX([folders_Struct].id) FROM [224].dbo.[folders_Struct]))"
  objOutputFile.WriteLine date & " " & time & " find last id for parentfolder id: " & vbcrlf & sql
Set tag = con_02.Execute(sql)
if not (tag.eof) then
   parfolid = tag(0).value
else
   parfolid = 0
end if
         
         sublvl=0
         tagsublvl=0
         lvl=1
         call retfol(ara01,pat,parfolid,"286_unigec",0)
         
         fbot.WriteLn("<br>Structure<br><br>")
         
         fbot.WriteLn("Dossiers nouveaux: " & newfol & "<br>")
         fbot.WriteLn("Dossiers déjà existants: " & dejfol & "<br>")
         fbot.WriteLn("Dossiers non créés, erreur: " & errfol & "<br><br>")
      '=== 05 === exchange =================
         
         fbot.WriteLn("FIN<br>")
         
      end if
      
      '=== permissions security acl ntfs

      ' F  Full control (can change permission too)
      ' M  Modify
      ' X  read & eXecute
      ' L  List folder contents
      ' R  Read
      ' W  Write

      '=== drive i: (old permissions)

      'Allowed  BUILTIN\Administrators  Full Control          This Folder Only
      'Allowed  \CREATEUR PROPRIETAIRE  Full Control          Subfolders and Files
      'Allowed  CORP\EMP_STAS       Modify                This Folder, Subfolde
      'Allowed  AUTORITE NT\Système     Full Control          This Folder, Subfolde
      'Allowed  CORP\Admins du domaine  Full Control          This Folder, Subfolde
      'Allowed  BUILTIN\Administrators  Full Control          Subfolders and Files
      'Allowed  CORP\EMP_STAS           Modify                This Folder, Subfolde
 
      fol01="i:\135\"
      ara01=array( _ 
      "STAS-HOST-01\administrators:F", _ 
      "corp\Admins du domaine:F", _ 
      "CORP\EMP_UNIGEC:M", _ 
      "CORP\EMP_STAS:M", _ 
      "CORP\fournier.serge:F", _ 
      "corp\Admins du domaine:F")
      b=""

      for each a in ara01
         b=b & """" & a & """ "
      next

      a="cscript.exe c:\_stas\224211-informatique\xCACLS.vbs """ & fol01 & """ /T /P " & act01 & b
      ' & "/user admin3 /pass ******"
      'err01 = objShe.Run("%COMSPEC% /c Echo Y| " & a, 2, True)
      c="aef.txt"

         Set objOutputFile02 = objfso.OpenTextFile("c:\_stas\" & c, 2, true)
         objOutputFile02.writeline(a)
         objOutputFile02.close

      '=== exchange

   end if

   '=== creation folders - permissions folders - exchange folders
   
   '=== 01 ============================ S T A S   E Q U I P E M E N T  ====================================================================
   
   if resbutlefstr="stasfolequ" or resbutlefstr="stasservice" then
   
   if resbutlefstr = "stasfolequ" then 
 cat="224_equipement"
   elseif resbutlefstr = "stasservice" then
 cat="224_service"
   else
      cat="autre"
   end if
   
   a = clefra(array("fmid","fbot"))

   '=== 02 ================ folder generation in i drive

      ara01 = array( _ 
      "Achats", _ 
      "Administration", _
      "Gestion_Projet", _ 
         array( "Communication","Budget","Echeancier","Gestion_envergure", "Qualite"), _ 
      "EMM", _ 
         array("ListeVerif","Mise_en_marche", _
array("Rapports","Resultats"), _
"Prog", _
array("Prog_PLC","Prog_HMI","Prog_G7","Prog_Document","Prog_Intrants"), _
"Photos"), _ 
"Production", _ 
array("Avis_Modif","RNC","Nomenclature","Cahier_de_charge"), _ 
"Technique", _ 
        array("Analyse_FNC", _ 
              "Elec_Calculs", _ 
array("Revisions_Anterieures"), _ 
 "Elec_Extrants", _ 
array("Revisions_Anterieures"), _ 
 "Elec_Intrants", _ 
array("Revisions_Anterieures"), _ 
 "Manuels", _ 
 "Mec_Calculs", _ 
array("Revisions_Anterieures"), _ 
 "Mec_Extrants", _ 
array("Revisions_Anterieures"), _ 
 "Mec_Intrants", _ 
array("Revisions_Anterieures"), _ 
 "Photos", _
array("Revisions_Anterieures"), _ 
 "Rapport", _
array("Revisions_Anterieures"), _ 
 "Securite"), _ 
      "Ventes", _ 
         array("Estimation","Intrants_clients", "Soumission")) 
 
      '=== 03 ===
      
      rap01=""
      sublvl=0
      tagsublvl=0
      lvl=1
      dirnam=array("\\corp.stas.local\stas\projets\")
      
      for each a in priara
         rap01 = rap01 & a
      next      
      
      rap01 = rap01 & "<form name=form01>"
      rap01 = rap01 & "<b><table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 "
      rap01 = rap01 & "style='border-collapse:collapse;border:none'>"
      'rap01 = rap01 & "<CAPTION></CAPTION><span style='color:purple'>" & vbcrlf
      
      '=== ara01 = folders, jagged array
      '=== con = contrat
      
      pat = ""
      
      '=== cli = client number
      '=== con = contrat number
      '=== pat = path server and client and contrat
      
      '=== create all sub folders (pat is empty so we just draw the table in html)
      pattot=0
      arapat=array(pat)
      
      '=== HTML only
      call retfol(ara01,"",0,"",0)
      
      'fmid.WriteLn("Total de la matrice de path: " & pattot & "<br>")
      
      rap01=rap01 & "</table></form>"
      
      fbot.WriteLn(rap01)
      
      '=== permissions security acl ntfs
      'objshe.run("c:\_stas\224211-informatique\xcacls.vbs \\ZSSERVER\Zaci\Ales /T /G <domainname>\administrator:F <domainname>\Ales:F") 
      'objshe.run("c:\_stas\224211-informatique\subinacl /noverbose /file \\ZSSERVER\Zaci\Ales /setowner=Ales") 
      'objshe.run("c:\_stas\224211-informatique\subinacl /noverbose /subdirectories \\ZSSERVER\Zaci\Alex /setowner=Ales") 
      
      '=== 04 ===
      
      x=0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Code du contrat"             '===== description displayed in front of the field
      namtmp(x)="text01"                      '===== name of variable for programming purpose
      deftmp(x)=""                            '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
      typtmp(x)="textbox"                     '===== type of data: textbox password (futur: more to come)
      errtmp(x)="###%% (### = client %% = contrat"     '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      buttmp=array("ok","cancel")             '===== at the end, there will be an "ok" button and a "cancel" button
      tit = "STAS - Structure dossier"
      a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
      
      do
         '=== flag to tell if the input is not valid
         err01=0
         '=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
         inpdon=0
         '=== "ok" button or "enter" key are the same
         '=== and nothing was pressed on left frame (control frame)
         
         if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then 
            '=== User has clicked the OK button, retrieve the values
            text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

            if len(text) < 5 then
               err01=1
               '=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
               if len(text) < 5 then
                  errtmp(0)="error - must be 5 char long at least"
               else 
                  errtmp(0)="ok"
               end if

               '=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
               a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
               '=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
               reskeymid=0
               resbutmidstr=""
            else
               '=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
               inpdon=1
               err01=0
            end if
         end if
         wscript.sleep 100
      
         '=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
         if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
            '=== if user pressed escape or cancel, we clear the frames
            if resbutmidstr="cancel" or reskeymid=27 then
               a = clefra(array("fmid","fbot"))
               resbutmidstr="cancel"
            end if
            exit do
         end if
      '=== if there was an input error and no one used left control frame to exit, we keep asking for input
      loop while err01<>0 or inpdon=0
      
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
         
         '=== cli = client number
         '=== con = contrat number
         '=== pat = path server and client and contrat
         
         '=== create basic folders I K S exchange
         cli=ucase(mid(text,1,3))
         con=ucase(right(text,len(text)-3))
         
         '=== b = path du i projets
         b = crebasfol(cli,con)
         
         '=== create all sub folders (pat is not empty so we create folders)
         
         newfol = 0
         dejfol = 0
         errfol = 0
         pattot = 0
         arapat=array(pat)
         pat = b
 
'=== find highest id - root folders still must be at 0
         sql = "SELECT id FROM [224].dbo.[folders_Struct] WHERE (id = (SELECT MAX([folders_Struct].id) FROM [224].dbo.[folders_Struct]))"
  objOutputFile.WriteLine date & " " & time & " find last id for parentfolder id: " & vbcrlf & sql
Set tag = con_02.Execute(sql)
if not (tag.eof) then
   parfolid = tag(0).value
else
   parfolid = 0
         end if
         
         sublvl=0
         tagsublvl=0
         lvl=1
         call retfol(ara01,pat,parfolid,cat,0)
         
         fbot.WriteLn("<br>Structure<br><br>")
                  
         fbot.WriteLn("Dossiers nouveaux: " & newfol & "<br>")
         fbot.WriteLn("Dossiers déjà existants: " & dejfol & "<br>")
         fbot.WriteLn("Dossiers non créés, erreur: " & errfol & "<br><br>")

         '=== 05 === exchange
         
         
         fbot.WriteLn("FIN<br>")

         reskeymid=0
         resbutmidstr=""
      
      end if
   end if
   
   '===================================================================================================================================================
   if resbutlefstr="test555" then
      
      '=== this was a test with multiple button value (one for each line)
      a = clefra(array("fmid","fbot"))
   
      x=0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="what do you want to display" '===== description displayed in front of the field
      namtmp(x)="text01"                      '===== name of variable for programming purpose
      deftmp(x)="hello world"                 '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
      typtmp(x)="textbox"                     '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter a text to display"     '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      buttmp=array("ok","cancel")             '===== at the end, there will be an "ok" button and a "cancel" button
      
      a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
      
      do
         '=== flag to tell if the input is not valid
         err01=0
         '=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
         inpdon=0
         '=== "ok" button or "enter" key are the same
         '=== and nothing was pressed on left frame (control frame)
         
         if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then 
            '=== User has clicked the OK button, retrieve the values
            text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

            if len(text) < 1 then
               err01=1
               '=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
               if len(text) < 1 then
                  errtmp(0)="error - must be 1 char long at least"
               else 
                  errtmp(0)="ok"
               end if

               '=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
               a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
               '=== there was an invalid input so we reset the key or button pressed to nothing so the loop can continue
               reskeymid=0
               resbutmidstr=""
            else
               '=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
               inpdon=1
               err01=0
            end if
         end if
         wscript.sleep 100
      
         '=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
         if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
            '=== if user pressed escape or cancel, we clear the frames
            if resbutmidstr="cancel" or reskeymid=27 then
               a = clefra(array("fmid","fbot"))
               resbutmidstr="cancel"
            end if
            exit do
         end if
      '=== if there was an input error and no one used left control frame to exit, we keep asking for input
      loop while err01<>0 or inpdon=0
      
      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frame
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
         fbot.WriteLn(text & "<br>")
      end if
      
      reskeymid=0
      resbutmidstr=""
      
   end if
   
   if resbutlefstr="newdb" then
      '=== create a new database mdb type (Access 2000)
      tit="new database" '=== title to display in fmid frame (input frame)
      
      '=== clear 2 frames (input: fmid, and result: fbot)
      '=== also clear the result button name for all frames and the key pressed on all frames
      a = clefra(array("fmid","fbot"))
      
      '=== dynamic generation of input form, and control buttons in fmid (middle or up frame, called "input" frame for more clarity, fmid object)
      
      '=== inputs to do before processing
      '=== you can add more input forms, at the end, there will be an "ok" button and a "cancel" button

      x=0
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Database name"      '===== description displayed in front of the field
      namtmp(x)="dbnam"                 '===== name of variable for programming purpose
      deftmp(x)="testmdbaccess2000"     '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)=".MDB enter name of DB file" '===== text to display after the form "facultatif" blue text "error" red text are special keywords

      x=x+1
      redim preserve distmp(x) :redim preserve namtmp(x) :redim preserve deftmp(x) :redim preserve typtmp(x) :redim preserve errtmp(x)
      distmp(x)="Table name"      '===== description displayed in front of the field
      namtmp(x)="tabnam"                 '===== name of variable for programming purpose
      deftmp(x)="table01"     '===== default value inside the form (the form will be 20 char long if no value here, but you can enter more)
      typtmp(x)="textbox"               '===== type of data: textbox password (futur: more to come)
      errtmp(x)="enter name of first table" '===== text to display after the form "facultatif" blue text "error" red text are special keywords
      
      buttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" button
      
      a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
      
      do
         '=== flag to say input is done, since there might be a defaut value, we must validate if user was finished
         inpdon=0
         err01=0
         
         '=== "ok" button or "enter" key are the same
         '=== and nothing was pressed on left frame (control frame)
         
         if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then 
      
            '=== User has clicked the OK button, retrieve the values
            dbnam = fmid.form01.dbnam.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input
            dbnam=lcase(dbnam)
            
            tabnam = fmid.form01.tabnam.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input
            tabnam=lcase(tabnam)

            if len(dbnam) < 1 or len(tabnam)<1 then
               err01=1
               '=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)
               if len(dbnam) < 1 then
                  errtmp(0)="error - name must be 1 char long at least"
               else 
                  errtmp(0)="ok"
               end if
               if len(tabnam) < 1 then
                  errtmp(1)="error - name must be 1 char long at least"
               else 
                  errtmp(1)="ok"
               end if

               '=== if the value was not good, we generate the dynamic input for again, with an error message after the form in red
               a = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
               reskeymid=0
               resbutmidstr=""
            else
               '=== the input was validated, we flag err01 to none, and flag inpdon to exit the loop
               inpdon=1
               err01=0
            end if
            
         end if
         wscript.sleep 100
      
         '=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorer
         if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
            '=== if user pressed escape or cancel, we clear the frames
            if resbutmidstr="cancel" or reskeymid=27 then
               a = clefra(array("fmid","fbot"))
               resbutmidstr="cancel"
            end if
            exit do
         end if
         
      '=== if there was an input error and no one used left control frame to exit, we keep asking for input
      loop while err01<>0 or inpdon=0
   '===  
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
         '=== all value were validated, we continue
         dbnam = dbnam & ".mdb"
      
         '=== chek if the file already exist
         Set objFolder2 = objFSO.GetFolder(basedir)'=== dir
         Set objFiles2 = objFolder2.files '=== fichiers

         found=0
         For Each objFile3 in objFiles2
            nomfile=objfile3.name
            nomfile=lcase(nomfile)
            if nomfile=dbnam then
               found=1
            end if
         next  
         if found=1 then
            a = clefra(array("fmid"))
            fbot.WriteLn("The file: <br>" & dbnam & "<br>Already exist<br><br>Please use EDIT DATABASE to manage it<br><br>")
            fbot.WriteLn("FIN<br><br>")
         
            fbot.WriteLn("LIST of table in the existing database:<br><br>")
            Set objcat = CreateObject("ADOX.Catalog")
            Set objcon = CreateObject("ADODB.Connection") 
            constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbnam
            objcon.open constr
            objcat.activeconnection=(objcon)
            for each tab in objcat.Tables
               If tab.Type = "TABLE" Then
                  fbot.WriteLn("<br>TABLES:<br><br>")
                  fbot.WriteLn(tab.name & "<br>")
                  fbot.WriteLn("<br>COLUMNS:<br><br>")
                  for each col in tab.columns
                     c = lcase(col.name)
                     fbot.WriteLn(c & "<br>Type: " & col.type & "&nbsp&nbsp&nbspAutoincrement: " & col.Properties("AutoIncrement") & "<br>")
                  next
               end if
            next
            objcon.close
            set objcat=nothing
            set objcon=nothing
         else
            a = clefra(array("fmid"))
            '=== formats: jet10 = 1 Jet11 = 2 Jet20 = 3 Jet3x = 4 Jet4x = 5 (Access 2000)
            Dim Catalog
            fbot.WriteLn("Creation ADOX catalog (adox.dll, access required)<br><br>")
         
            Set objcat = CreateObject("ADOX.Catalog")
            format = 5
            fbot.WriteLn("database creation: " & dbnam & "<br><br>")
         
            constr="Provider=Microsoft.Jet.OLEDB.4.0;" & "Jet OLEDB:Engine Type=" & Format & ";Data Source=" & dbnam
            objcat.Create constr

            '=== add a table in the database
            fbot.WriteLn("table creation: " & tabnam &"<br>")
            Set objtab = CreateObject("ADOX.table")
            objtab.name = tabnam
            objcat.Tables.Append objtab
            objcat.Tables.refresh
         
            '=== add a columns in the only existing table
            for each tab in objcat.Tables
               If tab.Type = "TABLE" Then
            
                  fbot.WriteLn("table existing: " & tab.name & "<br>")
                  '=== add column in database
                  Set objcol = Nothing
                  Set objcol = CreateObject("ADOX.Column")
            
                  'typdat=202   '=== string adVarWChar
                  'maxlen=250
                  'typdat=131   '=== float adnumeric
                  'maxlen=10
                  typdat=3     '=== integer adinteger
                  maxlen=10
             
                  if typdat=3 then a="adinteger"
                  if typdat=202 then a="adVarWChar"
                  if typdat=131 then a="adnumeric"
               
                  colnam="codint"
                  objcol.name = colnam
                  objcol.type = typdat
                  if typdat = 3 or typdat = 202 then 
                     objcol.DefinedSize = maxlen
                     if typdat=3 then
                        '=== must set parent catalog before setting autoincrement
                        Set objcol.ParentCatalog = objcat
                        objcol.Properties("AutoIncrement")=true
                     end if
                  elseif typdat = 131 then
                     objcol.precision = 28
                     objcol.numericscale = 8
                  end if
                  fbot.WriteLn("column creation: " & colnam & "<br>")
                  Tab.Columns.Append objcol

                  fbot.WriteLn("primary key creation: " & colnam & "<br>")
                  Set objkey = CreateObject("ADOX.key")
                  objkey.name="Primary"
                  objkey.columns.append colnam
                  tab.keys.append objkey
               
                  'Set aIndex = New ADOX.Index
                  'aIndex.Name = "ByField2"
                  'aIndex.Clustered = False
                  'aIndex.Columns.Append "Field2"
                  'aIndex.Columns.Append "Field1"
                  'aTable.Indexes.Append aIndex ' save the index

                  for each col in tab.columns
                     c = lcase(col.name)
                     fbot.WriteLn("column existing: " & c & "&nbsp&nbsp&nbspautoincrement status: " & objcol.Properties("AutoIncrement") & "<br>")
                  next
               
               end if
            next
         
            set objcat=nothing
         
            fbot.WriteLn("<br>You database have been created with 1 table and a defaut column named " & colnam & "<br>")   
            fbot.WriteLn("<br>END<br>")
         end if
      else
      'msgbox(resbutlefstr & "   " & resbutmidstr & "   " & resmidkey & "   " & bready)
   '===
      end if
      reskeymid=0
      resbutmidstr=""
      dbnam=""
   end if
   '===========================
   if resbutlefstr="edtdb" then
      resbutlefstr = ""

      a = clefra(array("fmid","fbot"))
      
      '=== value
      '=== chek if the file already exist
      Set objFol01=objFSO.GetFolder(basedir)'=== dir
      Set objfol02=objFol01.files '=== files
      
      x=0
      redim ara01(0)
      dimnum=1
      For Each objFil in objFol02
         filnam=objfil.name
         filnam=lcase(filnam)
         if right(filnam,4)=".mdb" then
            redim preserve ara01(x)
            ara01(x)=filnam
            x=x+1
         end if
      next
      
      '=== title of the columns
      aratit = array("Name of the database")

      '=== array to put in table, choice button, header, middle line, bottom line, reload
      a = dynbotcho(fmid, "choose the database to edit", aratit, ara01, 1 ,1, 1, 1, 1, 0,"mid")
     
      do
         wscript.sleep 100
      
         '=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorer
         if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
            '=== if user pressed escape or cancel, we clear the frames
            if resbutmidstr="cancel" or reskeymid=27 then
               a = clefra(array("fmid","fbot"))
               resbutmidstr="cancel"
            end if
            exit do
         end if    
      
      loop while resbutmidstr=""
      
      if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
         
         '=== convert the choice made with the button to a number (remove "but" from left side)
         a=right(resbutmidstr,len(resbutmidstr)-3)
         resbutmidstr=""
         '=== get the array that contain the choice in dbnam (database name)
         dbnam=ara01(a-1)
         
         '=== open the database
         Set objcat = CreateObject("ADOX.Catalog")
         Set objcon = nothing
         Set objcon = CreateObject("ADODB.Connection") 
         
         constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbnam
         objcon.open constr
         objcat.activeconnection=(objcon)
         
         '=== pressing left control button while in a function will call a sub make internet explorer crash
         '=== so i have to put the table choice in main loop, cant do a sub

         '=== choose the table to edit

         a = clefra(array("fmid","fbot"))
         
         aratit=array("Table name")
         x=0
         redim ara01(0)
         for each tab in objcat.Tables
            If tab.Type = "TABLE" Then
               c = lcase(tab.name)
               redim preserve ara01(x)
               ara01(x)=c
               x=x+1
            end if
         next
            
         a = dynbotcho(fmid, "Choose the table to edit", aratit, ara01, 1 ,1, 1, 1, 1, 0, "mid")
     
         do
            wscript.sleep 100
      
            '=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorer
            if resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
               '=== if user pressed escape or cancel, we clear the frames
               if resbutmidstr="cancel" or reskeymid=27 then
                  a = clefra(array("fmid","fbot"))
                  resbutmidstr="cancel"
               end if
               exit do
            end if    
         
         loop while resbutmidstr=""

         if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then
         
            '=== convert the choice made with the button to a number (remove "but" from left side)
            a=right(resbutmidstr,len(resbutmidstr)-3)
            resbutmidstr=""
            '=== get the array that contain the choice in dbnam (database name)
            tabnam=ara01(a-1)
            
            for each tab in objcat.Tables
               If tab.Type = "TABLE" Then
                  if tabnam = lcase(tab.name) then set objtab=tab
               end if
            next
            
           'sql = makque(symptom,tab,sel,whe," order by [probabilité] DESC","LIKE","%")
           sql = "select * from " & tabnam
           a = exesql(objcon,tag,sql)
            
           'i=0
           'For Each a In TAG.fields
           '=== columns names
           'if cc01<>0 then if i=0 then htmtab = htmtab & "<td><p>Select</td>"
           'htmtab = htmtab & "<td><p>" & Trim(a.Name) & "</td>"
           'i=i+1
           'Next
            
           if tag.eof=0 then
              myarray = TAG.GetRows()
           end if
           
           aratit=array("test")
           a = dynbotcho(fbot, tabnam, aratit, myarray, 1 ,1, 1, 1, 1, 1,"bot")
   
           '=== list columns in table
           'for each col in objtab.columns
           '   fbot.WriteLn(c & "<br>Type: " & col.type & "&nbsp&nbsp&nbspAutoincrement: " & col.Properties("AutoIncrement") & "<br>")
           'next
           do
               wscript.sleep 100
      
               '=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorer
               if resbutbotstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then
               '=== if user pressed escape or cancel, we clear the frames
                  if resbutmidstr="cancel" or reskeymid=27 then
                     a = clefra(array("fmid","fbot"))
                     resbutmidstr="cancel"
                  end if
                  exit do
               end if
         
            loop while resbutbotstr=""

            if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then  
               fbot.WriteLn(resbutbotstr)
            end if
         end if

      end if
      
      '========================== caca2
      
      
      
      'msgbox("exit on left button" & resbutlefstr)
      'resbutlefstr = ""
      resbutmidstr = ""
      resbutbotstr = ""
      reskeylef = 0
      reskeymid = 0
      reskeybot = 0
      
   end if
   
   if resbutlefstr="srcdb" then
   
   end if

   if resbutlefstr="test33" then
      
      '=== this was a test with multiple button value (one for each line)
      a = clefra(array("fmid","fbot"))
      
      fmid.WriteLn("<html><body>TEST</html></body>")
      '=== bottom section
      fbot.WriteLn("<html><body>TEST mid section")
      fbot.WriteLn("<html><body><form method='post' name='form1'>")
      
      butnam = "buttonbot"
      
      for ii=0 to 10
         fbot.WriteLn("<input type=""button"" style=""height:50px;font-size:14px;width:50%;"" name=""" & butnam & ii &""" value=""" & butnam & ii & """ ")
         fbot.WriteLn("style=""background-color: #cccccc; color: #000000;""><br>")
      next
      
      fbot.WriteLn("</form>")
      fbot.WriteLn("</html>")
      fbot.WriteLn("</body>")
      
      for ii=0 to 10
         fbot.forms(0).elements(butnam & ii).onclick = getref("buttonbot")
      next
      
      '=== loop until a button is pressed on left frame or ie is closed
      do
         wscript.sleep 100
         if resbutbotstr<>"" then
            fmid.WriteLn(resbutbotstr)
            resbutbotstr=""
         end if
      loop while resbutlefstr="" and bReady=false

      '=== ie is still open and but come button was pressed on left frame
      if bready=false and resbutlefstr<>"" then
         '=== we remove the actions on the buttons
         for ii=0 to 10
            fbot.forms(0).elements(butnam & ii).onclick = nothing
         next
         
         '=== clear frames, reset button value and keyvalue
         if resbutlefstr<>"quit01" then
            a = clefra(array("fmid","fbot"))
         end if
      end if
      
   end if
   
   '=== desarchivage (move files from archives to temp folder and pop outlook message)
   '=== here as reference onlym not working, missing a sub
   
   if resbutlefstr= "desarchive" then
      tit="Désarchivage"
      '=== refresh menu (chek button = 0)
      a = clefra(array("fmid","fbot"))
      '=== inputs to do before processing
   
      distmp=array("Login","Password","Numéro(s) de contrat")
      namtmp=array("login","password","connum")
      deftmp=array("","","")
      typtmp=array("textbox","password","textbox")
      errtmp=array("Facultatif","Facultatif","")
      buttmp=array("ok","cancel")
   
      a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
   
      do
         err01=0

         if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then 
      
            '=== User has clicked the OK button, retrieve the values
            connum = fmid.form01.connum.Value
         
            if len(connum) < 5 then
               a = "error - contrat doit avec 5 caractères"
               err01=1
               errtmp(2)=a
               a = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)
            end if
         end if
         wscript.sleep 100
         if resbutmidstr="cancel" or reskeymid=27 then exit do
      loop while (err01<>0 and resbutlefstr="") or (connum="" and resbutlefstr="")

      if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then
         '=== doing the job, all input are ok
      
         clefra(array("fmid"))

         a = desarchive2(connum,fbot)
      
         fbot.WriteLn("done<br>")
      
         resbutmidstr=""
         reskeymid=0
      
      elseif resbutlefstr="" and (resbutmidstr="cancel" or reskeymid=27) then
         '=== nothing was pressed on left, but cancel was used or escape
         a = clefra(array("fmid","fbot"))
      elseif resbutlefstr<>"" then
         '=== sometthing hapenned with the buton on the left side (menu/control)
         a = clefra(array("fmid","fbot"))
      end if

   end if
   '=== .1 seconds 
   wscript.sleep 100
   
'=== we loop until internet explorer was closed or the quit button was pressed
loop until bReady or resbutlefstr="quit01"

'======================
'====================== end of main loop
'======================

'=== someone pressed "quit" on left frame (control frame, flef object)

'=== at the end, if internet explorer was not closed, we close it
if bready=false then
   oie.quit
   set oie=nothing
end if

'=== we end wscript.exe, exiting all running code interpretation
wscript.quit

'==================================================================================================

'=== many subs

'=== if internet explorer is closed (event) we change bready value to TRUE
sub IE_onQuit()
   bReady=true
end sub

'=== database creation, mdb, access 2000
function credb()
   '=== formats: jet10 = 1 Jet11 = 2 Jet20 = 3 Jet3x = 4 Jet4x = 5

   '=== Create Access2000 database
   CreateNewMDB basedir & "test.mdb", 5

   '=== list of tables to create
   alltab(0) = "tab01"
   alltab(1) = "components"
   alltab(2) = "diagnostic"
   alltab(3) = "causes"

   '=== with a column for identification, numerical, autoincremental

   '=== 0 creation columns
   '=== 1 search in thoses columns
   '=== 2 fast/short results columns
   '=== 3 detail results columns

   '=== columns to create (first numner is table number, second is array number, 0 = creation)
   allara(0,0) = array( _
   "[codeint]", _
   "[test01]")

   '=== columns to search in

   '=== short result (What columns to display if the result should be short)

   '=== detailed results (almost all columns with data)

end function

'============================================== subs and functions ====================================

Sub CreateNewMDB(FileName, Format)
  Dim Catalog
  Set Catalog = CreateObject("ADOX.Catalog")
  Catalog.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & "Jet OLEDB:Engine Type=" & Format & ";Data Source=" & FileName
End Sub

'=== frames clear content by navigating to a blank
'=== input is an array containing name of frames as "flef" = frame left
'=== this sub generate a code and execute it in a string (cc)
'=== fully dynamic programming at it's best ;)

function clefra(aara)
   'Do Until .Document.ReadyState = "complete"
   '   DoEvents
   'Loop
   
   cc=""
   for each aa in aara
      cc = cc & "Do While (oIE.Busy)" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & "Do While oie.readystate<>4" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & aa & ".location.reload(true)" & vbcrlf
      cc = cc & "Do While (oIE.Busy)" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & "Do While " & aa & ".ReadyState = ""Terminé"" or " & aa & ".ReadyState = ""Complete""" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & "Do While oie.readystate<>4" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & aa & ".WriteLn(""&nbsp;"")" & vbcrlf
      cc = cc & aa & ".location.reload(true)" & vbcrlf
      cc = cc & "Do While oie.readystate<>4" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & "Do While (oIE.Busy)" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
      cc = cc & "Do While " & aa & ".ReadyState = ""Terminé"" or " & aa & ".ReadyState = ""Complete""" & vbcrlf
      cc = cc & "   wscript.sleep 200" & vbcrlf
      cc = cc & "Loop" & vbcrlf
   next

   execute cc
   
   '=== we also clear the variables used to control the action buttons and the key pressed in each frames
   '=== so the action wont be taken twice (or infinitly) in the main loop
   
   'set flef = oie.document.frames("left").document
   'set fmid = oie.document.frames("middle").document
   'set fbot = oie.document.frames("bottom").document
   
'for i=0 to ubound(arabutnam)
'   flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
'next

'=== we also chek the key presse in each frame
'=== we do this cause we want "enter" key to be used instead of pressing "ok" button with the mouse
'set flef.onkeypress = GetRef("Checklef") 
'set fmid.onkeypress = GetRef("Checkmid") 
'set fbot.onkeypress = GetRef("Checkbot") 

   resbutlefstr = ""
   resbutmidstr = ""
   resbutbotstr = ""
   reskeylef = 0
   reskeymid = 0
   reskeybot = 0
end function

'=== form dynamically generated =========================================================================

function dynforgen (distmp, namtmp,deftmp,typtmp,errtmp,buttmp,title)
   
   '=== generate a form for input in the input frame (fmid object)
   '=== focus on the first field with no default value
   '=== display suffix message in red if "error" (or "erreur" - french) keyword is in it
   
   fmid.WriteLn("<h3><span class=SpellE>" & title & "</span></h3>")
   '=== default focus on empty field (with no default value)
   deffoc=0
   for ii=0 to ubound(namtmp)
      if deftmp(ii)="" then
         if instr(lcase(errtmp(ii)),"facultatif")=0 then
            fmid.WriteLn("<BODY onLoad=""document.form01." & namtmp(ii) & ".focus()"">")
            deffoc=1
         end if
      end if
      '=== no default value empty, we focus on first field
   next
   if deffoc=0 then
      fmid.WriteLn("<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">")
   end if
   fmid.WriteLn("<div class=MsoNormal align=center style='text-align:center'>")
   fmid.WriteLn("</div>")

   fmid.WriteLn("<form name=form01>")

   '=== button and error message
   for ii=0 to ubound(namtmp)

      fmid.WriteLn(distmp(ii) & ": ")

      '=== we disable "enter" to submit form because we manage this event as a onkeypress in the parent frame of the form later
      '=== we had to do this, because the web page form is not run on a server, and the web page dont have control, the VBS script outside the page have control
      
      fmid.WriteLn("<input type=""" & typtmp(ii) & """ id=" & namtmp(ii) & " NAME=""" & namtmp(ii) & """ size=""" & max(20,len(deftmp(ii))) & """ value=""" & deftmp(ii) & """ onKeypress=""return event.keyCode!=13""")
      'fmid.WriteLn("")
      if instr(lcase(errtmp(ii)),"error")<>0 or instr(lcase(errtmp(ii)),"erreur")<>0 then
         col="red"
      else
         col="blue"
      end if
      fmid.WriteLn("&nbsp; <b><span style='color:" & col & "'>&nbsp" & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>")
   next

   fmid.WriteLn("<![if !supportLineBreakNewLine]><br style='mso-special-character:line-break'>")
   fmid.WriteLn("<![endif]></p>")
   
   for ii=0 to ubound(buttmp)
      typ01 = "button"
      fmid.WriteLn("<input type=""" & typ01 & """ name=""" & buttmp(ii) & """ value=""&nbsp;" & buttmp(ii) & "&nbsp;"">")
      fmid.WriteLn("&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp")
   next
   
   fmid.WriteLn("</div>")
   fmid.WriteLn("</form>")
   fmid.WriteLn("</body>")
   fmid.WriteLn("</html>")

   fmid.location.reload(true)

   '=== wait for internet explorer to be ready after we refresh the page with the new form
   for ii=0 to ubound(buttmp)
      Do While (oIE.Busy)
         wscript.sleep 100
      loop
      do while oie.readystate<>4
         wscript.sleep 100
      Loop
      '=== value to return for each button in the form
      fmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")
   next
   
   '=== regenerate the event that call a sub if a button is pressed
   set fmid.onkeypress = GetRef("Checkmid") 
   
   '=== clear button pressed and key pressed for this frame
   resbutmidstr=""
   reskeymid=0
end function

'===  max
Function max(a, b)
If a > b Then max = a Else max = b
End Function

function crewebmai(oie, doctit, maitit, arabutnam, arabutdes, aradepnam, aradepcol)

'=== create an internet explorer object (oie) that will be in 3 frames (flef, fmid, fbot), acting at the main interface for all this program

oie.FullScreen = False
'.ToolBar   = False
'.StatusBar = False
'.Navigate("About:Blank")
'.visible = true

oIE.left=0 ' window position
oIE.top = 0 ' and other properties
'.ParentWindow
'        .resizeto 640,300
'        .moveto (.screen.width
oIE.height = 500
oIE.width = 500
oIE.menubar = 1 '=== no menu
oIE.toolbar = 1
oIE.statusbar = 1
oIE.RegisterAsDropTarget = True
oie.Navigate("about:blank")
oie.document.title = doctit
oiewid = oie.document.parentwindow.screen.width
oiehei = oie.document.parentwindow.screen.height
sizwidpercent = 100
sizheipercent = 95
loswid = 100-sizwidpercent
loshei = 100-sizheipercent
newwid = oiewid*sizwidpercent*.01
newhei = oiehei*sizheipercent*.01
oie.document.parentwindow.resizeto newwid,newhei
newx = oiewid * loswid * .01 /2
newy = oiehei * (loshei/2) * .01 /2
oie.document.parentwindow.moveto newx, newy
oIE.visible = 1 '=== visible on
oie.addressbar=false 

'=== we will always have 3 frames, control, input and output (flef, fmid, fbot)
'=== used an array to have a good view of the line of html and possibility to add something else easily
aratmp=array(_ 
"<HTML>",_ 
"<HEAD><TITLE>" & doctit & "</TITLE></HEAD>",_ 
"<FRAMESET COLS=""13%, *"">",_ 
"<FRAME SRC=""About:Blank"" NAME=""left"">",_ 
"<frameset rows=""30%,70%"">",_
"<FRAME SRC=""About:Blank"" NAME=""middle"">",_ 
"<body background=""" & basedir & "LOGO-STAS-FOND.jpg"">",_
"<FRAME SRC=""About:Blank"" NAME=""bottom"">",_ 
"</FRAMESET>",_ 
"</HTML>")

'oie.Navigate("About:Blank")

'=== send the array content in internet explorer to create 3 frames
for i = 0 to UBound(aratmp, 1)
   oie.document.WriteLn(aratmp(i))
next
oie.refresh
Do While (oIE.Busy)
   wscript.sleep 100
Loop

'=== wait till document loaded
do while oie.readystate<>4
   wscript.sleep 100
Loop

'=== vista activate
'=== make internet explorer the main active window
a = objShe.AppActivate("http:/// - " & doctit & " - M")
a = objShe.AppActivate(doctit & " - M")

'=== theses objects are used to send data to the 3 different frames
'=== if you dont define them as object, the access to them is very slow when we use the names instead of the objects

'=== object used to write in a frame with writeln
set flef = oie.document.frames("left").document
set fmid = oie.document.frames("middle").document
set fbot = oie.document.frames("bottom").document

'=== object used to navigate an empty page in a frame
'set flefl = oie.document.frames("left").location
'set fmidl = oie.document.frames("middle").location
'set fbotl = oie.document.frames("bottom").location

'=== string result for a button press in a frame (lef = left frame, mid = middle frame (up))
resbutlefstr=""
resbutmidstr=""
resbutbotstr=""

reskeylef=0
reskeymid=0
reskeybot=0

'=== all the chek to be made in first page (1 at the moment, since ready have many values)

nbrbut=UBound(arabutnam, 1)
redim buttag(nbrbut)
form = "flef"

flef.WriteLn("<html><body>")
flef.WriteLn("<body background=""" & basedir & "LOGO-STAS-FOND.jpg"">")
flef.WriteLn("<h3><span class=SpellE>" & maitit & "</span></h3>")
flef.WriteLn("<form name='form1'>")

for i=0 to ubound(arabutnam)
   
   '=== convert xls to mdb button appear for stas only
   
   if ((usenam="wildboy" or usenam="fournier.serge" or usenam="fortin.jp" or usenam="lavoie.daniel" or usenam="doucet.gm") and arabutnam(i)="excel2mdb") or arabutnam(i)<>"excel2mdb" then
   
      'style="background-color: #cc0000; color: #ffffff;" /
      b = "<input type=""button"" style=""height:50px;font-size:14px;width:100%;"" name=""" & arabutnam(i) & """ value=""" & arabutdes(i) & """"
      i2=i
      if i>ubound(aradepnam) then
         i2=ubound(aradepnam)
      else
         a=aradepnam(i2)
      end if

      if a<>lasdep then
         '=== new departement name
         flef.WriteLn( "<br>" & a & "<br>")
         lasdep=a       
      end if
      b = b & " style=""background-color: #" & aradepcol(i2) & "; color: #000000;""><br>"
      flef.WriteLn(b)
   end if
next

flef.WriteLn("</form>")
flef.WriteLn("</body>")
flef.WriteLn("</html>")

'=== we dont refresh this frame, its the first one

end function

'=== sub to call when something is pressed
'=== called for many buttons, return the button name or a keyboard code (Ascii)
sub buttonlef
   set src = flef.parentWindow.event.srcElement
   resbutlefstr = src.name
end sub

sub buttonmid
   set src = fmid.parentWindow.event.srcElement
   resbutmidstr = src.name
end sub

sub buttonbot
   set src = fbot.parentWindow.event.srcElement
   resbutbotstr = src.name
end sub

sub Checklef
   reskeylef = flef.parentWindow.event.keycode
end sub

sub Checkmid 
   reskeymid = fmid.parentWindow.event.keycode
end sub

sub Checkbot
   reskeybot = fbot.parentWindow.event.keycode
end sub

'=== chek in the actual folder if a file exist
function filsea(filname)

'=== chek also actual folder for a "Rappel_LOG" file (instr)
Set objFolder2 = objFSO.GetFolder(basedir)'=== dir
Set objFiles2 = objFolder2.files '=== fichiers

found=0  '=== fichier de rapport pas trouve
For Each objFile3 in objFiles2
   nomfile =objfile3.name
   nomfile= lcase(nomfile)
   
next  


end function

'=== delete a table in a database

function tabdel()
         
         for each tab in objcat.Tables
            If tab.Type = "TABLE" Then
               b=lcase(tab.name)
               '=== object.delete not supported, so we delete with name
               objcat.tables.delete b
               fbot.WriteLn("delete: " & b & "<br>")  
            END IF
         next

end function

'=== for reference
function dynbotcho00
               i3=0
               For each dia01 in choiceara
                  sql = makque(dia01,tab,sel,whe,"","=","")
                  a = exesql(objcon,tag,sql)

                  '=== make same array for a multiples queries
                  if tag.eof=0 then
                     'a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3
                     if ubound(choiceara)=0 and i3=0 then
                        a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3
                     elseif i3=0 then
                        '=== header
                        a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,0,0) '=== 1 2 3
                     elseif i3<>ubound(choiceara) and i3<>0 then
                        '=== footer
                        a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,0,0) '=== 1 2 3
                     elseif i3=ubound(choiceara) then
                        a = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,1,1) '=== 1 2 3
                     end if
                     i3 = i3 + 1
                  else
                     '=== 0 results
                     a = nores(sql)
                  end if
               next
end function

function dynbotcho(ffra, ttext, aaratit, aara, cc01 ,hh, mm, ff, rr, ttxtbox,ffranam)
   '=== ffra frame to use for display (object)
   '=== ttext to display
   '=== aara = array with what to display
   '=== cc = choice button
   '=== sql = sql query for debugging
   '=== hh = 1 = header 
   '=== mm = 1 = middle
   '=== bb = 1 = footer
   '=== rr = 1 = reload at end
   '=== ttxtbox = all data are in a textbox so we can edit them
   call oieready
   xmax = UBound(aara, 1) 'Returns the Number of columns  --- elements in first dimension
   on error resume next
   '=== chek the number of elements in second dimension, if there is none, then the array is only a list with 1 column
   ymax = UBound(aara, 2) 'Returns the Number of rows     --- elements in second dimension
      
   '=== number of dimensions in case there is only 1 column
   if err<>0 then
      dimnum=1
   else
      dimnum=2
   end if
   on error goto 0
   
   '=== web script for buttons to return the number of the button that was pressed

   '=== print button
   if hh=1 then
      for each a in priara
         ffra.WriteLn(a)
         ffra.WriteLn("<form name=form01>")
         'ffra.WriteLn("<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">")
      next
   end if
   
   '=== select buttons
   if cc01<>0 then 
      '=== buttons var only if select is active
      if cc01<>0 then
         for yy=0 to ymax
         
         next
      end if
   end if
   
   fast=1
   '=== header
   if hh=1 then
      
      htmtab = ttext & "<b><table width=""100%"" BORDERCOLOR=""black"" class=MsoTableGrid border=1 CELLSPACING=0 cellpadding=2 style='border-collapse:collapse;border:none'>"
      htmtab = htmtab & "<CAPTION></CAPTION><span style='color:purple'>" & vbcrlf
      if fast=1 then ffra.WriteLn(htmtab):htmtab=""
      '=== tableau html
      htmtab = htmtab & "<TR>"
      if fast=1 then ffra.WriteLn(htmtab):htmtab=""
      i=0
      For Each a In aaratit
         '=== columns names
         if cc01<>0 then if i=0 then htmtab = htmtab & "<td><p>Select</td>"
         '=== test to  text box inside each field with a default value for editing
         test=0
         if test=0 then
            htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"
            if fast=1 then ffra.WriteLn(htmtab):htmtab=""
         else
            '=== futur button to order by that column
            '=== futur textbox to search in this column
            htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"
            if fast=1 then ffra.WriteLn(htmtab):htmtab=""
         end if
         i=i+1
         if dimnum=1 then exit for
      Next
         htmtab = htmtab & "</tr>"
         if fast=1 then ffra.WriteLn(htmtab):htmtab=""
   end if
      
   '=== middle
   if mm=1 then
      
      '=== x is inversed when only one column
      if dimnum=1 then ymax=xmax
      
      For yy = 0 To ymax
         htmtab = htmtab & "<TR>"
         if dimnum=2 then
            'ffra.WriteLn(yy)
            For xx = 0 To xmax
               'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""
               if xx=0 and cc01<>0 then
                  htmtab = htmtab & "<td><p>"
                  htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
                  htmtab = htmtab &  " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
                  htmtab = htmtab & "</td>"
                  if fast=1 then ffra.WriteLn(htmtab):htmtab=""
               end if
                
            if ttxtbox=0 then 
               htmtab = htmtab & "<td><p>" & aara(xx, yy) & "</td>"
               if fast=1 then ffra.WriteLn(htmtab):htmtab=""
            else
               'aa="<input type=""textbox"" style=""width:100%;"" id=""box" & xx & "_" & yy & """ NAME=""box" & xx & "_" & yy & """ size=""" & max(1,len(aara(xx, yy))) & """ value=""" & aara(xx, yy) & """ onKeypress=""return event.keyCode!=13"""
               ffra.WriteLn("<td><p><input type=""textbox"" style=""width:100%;"" id=""box" & xx & "_" & yy & """ NAME=""box" & xx & "_" & yy & """ size=""" & max(1,len(aara(xx, yy))) & """ value=""" & aara(xx, yy) & """ onKeypress=""return event.keyCode!=13""></td>")
               'htmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"
               'if fast=1 then ffra.WriteLn(htmtab):htmtab=""
            end if
            Next
         else
         '=== there is only 1 column
            htmtab = htmtab & "<td><p>"
            htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(yy+1)) & """ value=""" & "Select " & yy+1 & """"
            htmtab = htmtab &  " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
            htmtab = htmtab & "</td>"
            
            if ttxtbox=0 then 
               htmtab = htmtab & "<td><p>" & aara(yy) & "</td>"
            else
               aa="<input type=""textbox"" style=""width:100%;"" id=""box" & yy & """ NAME=""box" & yy & """ size=""" & max(1,len(aara(yy))) & """ value=""" & aara(yy) & """ onKeypress=""return event.keyCode!=13"""
               htmtab = htmtab & "<td><p>" & aa & "</td>"
               'htmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"
            end if
            
         end if
         htmtab = htmtab & "</tr>" & vbcrlf
         if fast=1 then ffra.WriteLn(htmtab):htmtab=""
   
      Next
   end if
      
   '=== footer
   if ff=1 then
      htmtab = htmtab & "</table></span></b><br>"
      if fast=1 then ffra.WriteLn(htmtab):htmtab=""
   end if
   
   htmtab = htmtab & "</form>"
   if fast=1 then ffra.WriteLn(htmtab):htmtab=""
   if fast=0 then ffra.WriteLn(htmtab)
      
   '=== reload (will not reload if we are in middle of a muliple elements/query table)
   if rr=1 then
      ffra.location.reload(true)
      call oieready
   end if
   
   '=== ?
   if mm=1 then
      For yy = 0 To ymax
         if dimnum=2 then
            ffra.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("button" & ffranam)
         else
         '=== there is only 1 column
            ffra.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("button" & ffranam)
         end if
      Next
   end if

   set ffra.onkeypress = GetRef("Check" & ffranam)
   
   'for i=0 to ubound(arabutnam)
   '   flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")
   'next
end function

sub oieready()
   do while oie.readystate<>4
      wscript.sleep 100
   loop
   Do While (oIE.Busy) 
      wscript.sleep 100
   Loop
end sub


'=== ssea = search string 

'=== tab 0 symptoms
'=== tab 1 components
'=== tab 2 diagnostics
'=== tab 3 causes

'=== ttyp 0 search
'=== ttyp 1 fast results
'=== ttyp 2 detail results

'=== ssufix = ordere by or something at the end of query

function makque(ssea, ttab, sselect,wwhere, ssufix,ooper,wwild)
   ssea = replace(ssea,"'","''")
   ssea = trim(ssea)
   sseaara = split(ssea," ") '=== array of all words for search
   
   ss = "select "
   
   ii = 0
   for each aa in allara(ttab,sselect)
      ss = ss & aa
      if ii<>ubound(allara(ttab,1),sselect) then ss = ss & ","
      ii=ii+1
   next
   
   ss = ss & " from [" & alltab(ttab) & "] where ("
   
   '=== search word(S) in table, AND opérator
   ii = 0
   for each ss2 in sseaara
      ii2=0
      for each aa in allara(ttab,wwhere)
         ss = ss & "[" & aa & "] " & ooper & " '" & wwild & ss2 & wwild & "'"
         
         if ii2 <> UBound(allara(ttab,wwhere), 1) then ss = ss & " or "
         ii2=ii2+1
      next
      if ii <> UBound(sseaara, 1) then ss = ss & ") and ("
      ii=ii+1
   next
   '=== order by a column name
   ss = ss & ")" & ssufix

   makque = ss

end function

function exesql(objcon,tag,sql)

   on error resume next
   set tag = objcon.execute(SQL)
   if err<>0 then
      l1 = "error in query"
      l2 = "query: " & sql
      l3 = "error: " & err.description
      l4 = "the program will now end"
      fbot.WriteLn(l1 & "<BR><br>" & l2 & "<BR><br>" & l3 & "<BR><br>" & l4 & "<BR><br>")
      'msgbox(l1 & vbcrlf & l2 & vbcrlf & l3 & vbcrlf & l4 & vbcrlf)
      wscript.quit
   end if
   on error goto 0

end function


'=== sort an array in alpha order
Function sorara(aara)
   
   For i = (UBound(aara) - 1) to 0 Step -1
      For j= 0 to i
         'if isarray(aara(j))=0 and isarray(aara(j+1))=0 then
         If UCase(aara(j))>UCase(aara(j+1)) Then
            sstrHolder = aara(j+1)
            aara(j+1) = aara(j)
            aara(j) = sstrHolder
         End If
         'end if
      Next
   Next
   sorara=ara01
End Function

'Function fSortArray(aSortThisArray)
'Set oArrayList = CreateObject("System.Collections.ArrayList" )
'For iElement = 0 To UBound(aSortThisArray)
'  oArrayList.Add aSortThisArray(iElement)
'Next
'oArrayList.Sort
'set fSortArray = oArrayList
'Set oArrayList = Nothing
'End Function

'================================================
function makfol(ffil01, array02)

if objfso.folderexists(ffil01) then
   cc= errman(1,"i - le dossier existait déjà")
else
   a=OBJfso.CreateFolder(ffil01)
   if err.number=0 then
      cc= errman(0,"i - dossier crée")
   else
      cc= errman(2,"i - " & err.description)
   end if
end if

end function

'=== create basic folder with TEXT (client and contract)

function crebasfol(ccli,ccon)

         '=== split client and contract

         aa = clefra(array("fbot"))
         
         fbot.WriteLn("Client: " & ccli & "<br><br>")   
         fbot.WriteLn("Contrat: " & ccon & "<br><br>")   
         
         '=== k originaux utilisation
         
         aa = "\\corp.stas.local\stas\ORIGINAUX\Utilisation"
         
         '==== creation client folder if necessary
         bb = aa & "\" & ccli
         zz = crefol(bb)
         
         '=== creation contract folder
         bb = aa & "\" & ccli & "\" & ccon
         zz = crefol(bb)         
         
         '=== s administ
         
         aa = "\\corp.stas.local\stas\administ\CLIENT"
         
         '==== creation client folder if necessary
         bb = aa & "\" & ccli
         zz = crefol(bb)
         
         '=== creation contract folder
         bb = aa & "\" & ccli & "\" & ccon
         zz = crefol(bb)         
         
         '=== I projets
         
         aa = "\\corp.stas.local\stas\projets"
         
         '==== creation client folder if necessary
         bb = aa & "\" & ccli
         zz = crefol(bb)
         
         '=== creation contract folder
         bb = aa & "\" & ccli & "\" & ccon
         zz = crefol(bb)         

         crebasfol = bb

end function

function crefol(bbb)

         if objfso.folderexists(bbb) then
            fbot.WriteLn("le dossier existait déjà: "& bbb & "<br>")
         else
            on error resume next
            zzz=OBJfso.CreateFolder(ucase(bbb))
            if err<>0 then
               fbot.WriteLn("ERROR: dossier NON crée: " & bbb & "<br>")
            else
               fbot.WriteLn("Dossier crée: " & bbb & "<br>")
            end if
            on error goto 0
         end if

end function


'=== retroactive call that explore jagged array

'=== aa = folders, jagged array
'=== ccon = contract

sub retfol(aa, ppath, parentfol, categorie, revision)
   
   '=== perentfol is a local variable, and recursiveness will make a new one every sub level
   '=== when the level go back (sub return) the precedent value will be there, because it's local
   
   '=== we put content in rap01 including a print button and a table html format

   'ON ERROR RESUME NEXT
   
   for each bb in aa
      
      if not isarray(bb) then
         bb=replace(bb," ","_")
         bb=replace(bb,"é","e")
         bb=replace(bb,"É","E")
         bb=replace(bb,"ç","c")
         bb=replace(bb,"Ç","C")
         bb=replace(bb,"è","e")
         bb=replace(bb,"È","E")
         bb=replace(bb,"ê","e")
         bb=replace(bb,"Ê","E")
         bb=replace(bb,"à","a")
         bb=replace(bb,"À","A")
         bb=replace(bb,"û","u")
         bb=replace(bb,"Û","U")
         
         '=== if sublvl = 1 it mean we were in a sub array
         '=== string(sublvl*6,"-")
         ii=sublvl
         rap01=rap01 & "<tr>"
         do while ii>0
            rap01=rap01 & "<td></td>"
            ii=ii-1
         loop
         
         '=== if the ppath is nothing, we just draw the html table, no folder creation or database creation
         if ppath<>"" then
            
            '=== create subfolders
            redim preserve arapat(pattot)
            arapat(pattot)=bb
            
            dd=path
            for each cc in arapat
               dd=dd & "\" & cc
            next

            'fbot.WriteLn(pat & dd & "<br>")
            ee = pat & dd
            
            '==== creation client folder if necessary
             if objfso.folderexists(ee) then
                
                'fbot.WriteLn("WARNING: le dossier existait déjà: "& ee & "<br>")
                dejfol = dejfol + 1
                fbot.WriteLn("simulation dossier: " & ee & "<br>")
                fbot.WriteLn("simulation dossier: " & sublvl & "<br>")

             else
                on error resume next

'=== create folder ================================
                zz=OBJfso.CreateFolder(ee)
                
                if err<>0 then
                   fbot.WriteLn("ERROR: " & err.description & "   ERROR DATA: " & ee & "<br>")
                   errfol = errfol + 1
                else
                   newfol = newfol+1
                end if
                on error goto 0
                
                fbot.WriteLn("Dossier crée: " & ee & "<br>")
             end if
             
             '=== SQL folder creation

             if parentfol="" then
   msgbox("par2: " & par2 & vbcrlf & "parentfol: " & parentfol)
    end if
            
sql = "SELECT COUNT(*) As 'Count' FROM [224].dbo.folders_struct "
sql = sql & "WHERE nom like '" & bb & "' and parentfol = " & parentfol & " and categorie = '" & categorie & "'"
'objOutputFile.WriteLine date & " " & time & " does database exist? " & vbcrlf & sql
objOutputFile.WriteLine date & " " & time & " sublvl value: " & sublvl
            objOutputFile.WriteLine date & " " & time & " check if element exist " & vbcrlf & sql
            
Set tag = Con_02.Execute(sql)

if tag("count") = 0 then

i=0
tables = ""
values = ""
for each a in aracolnam
tables = tables & aracolnam(i) & ","
if a="nom" then
values = values & "'" & bb & "',"
elseif a="parentfol" then

'=== caca
if sublvl=0 then 
  par2=0
  parentfol=0
  objOutputFile.WriteLine date & " " & time & " replaced by 0 sublvl: " & sublvl & "   parentfol: " & parentfol
else 
  par2 = parentfol
  objOutputFile.WriteLine date & " " & time & " not replaced = parentfold sublvl: " & sublvl & "   parentfol: " & parentfol
end if
objOutputFile.WriteLine date & " " & time & " sublvl: " & sublvl & "   parentfol: " & parentfol
values = values & par2 & ","
elseif a="categorie" then
values = values & "'" & categorie & "',"
elseif a="revision" then
values = values & revision & ","
elseif a="permission" then
values = values & "'',"
else
values = values & "''," '=== this should never happen cause an empty numeric value will bug here in sql
end if
i=i+1
next
tables = left(tables,len(tables)-1)
values = left(values,len(values)-1)
'aracol = array( _ 
'"nom", _ 
'"parentfol", _ 
'"permission", _ 
'"categorie", _ 
'"revision", _ 
'"actif")

sql = "insert into [224].dbo.folders_struct (" & tables & ") values(" & values & ")"
objOutputFile.WriteLine date & " " & time & " insert new element " & vbcrlf & sql
Set tag = Con_02.Execute(sql)

end if

'=== go get identity key for next folder or subfolder
sql = "SELECT [id],[nom],[parentfol] FROM [224].dbo.folders_struct "
sql = sql & "WHERE nom like '" & bb & "' and parentfol = " & parentfol & " and categorie = '" & categorie & "'"
objOutputFile.WriteLine date & " " & time & " get identity for parentfol" & vbcrlf & sql
Set tag = Con_02.Execute(sql)

if not tag.eof then
parentfoltmp = tag(0).value
objOutputFile.WriteLine date & " " & time & " parent folder id: " & tag(0).value
else
   
objOutputFile.WriteLine date & " " & time & " --- no element found - no id for next parentfol (parent folder)"
end if
             
         end if
         
         '=== just draw the html
         rap01=rap01 & "<td>" &  bb & "</td></tr>"
      else
         '=== the next value is an ARRAY, we recurse
         sublvl=sublvl+1
         pattot=pattot+1
         'if parentfoltmp="" then parentfoltmp = 0
         call retfol(bb,ppath,parentfoltmp,categorie, revision)
         
      end if
   next
   
   sublvl=sublvl-1
   pattot=pattot-1

end sub

'================================= database and table and columns creation sub

sub credb(dbname, tabname, aracolnam, aratype, aracolunique, logfile, sqlcon, dataset)

'=== sub to create a database in sql (2008), database name and table will be put in []
'=== dbname       = database name 
'=== tabname      = table name
'=== aracolnam    = array with all columns names
'=== aratype      = type of data in each columns
'=== aracolunique = FUTUR will create the column with uynique value, even if it's nor identity
'=== logfile      = txt file to log progress, error etc
'=== sqlcon       = connexion SQL
'=== dataset      = dataset object, contain data from sql queries

'=== put all column NAME and TYPE in a string for sql query
i=0
tables=""
for each a in aracolnam
tables = tables & aracolnam(i) & " " & aratype(i) & ","
i=i+1
next
'=== remove last extra ,
tables = left(tables,len(tables)-1)

'=== DATABASE === check if database exist
sql = "SELECT COUNT(*) As 'DBCount' FROM master.dbo.sysdatabases WHERE name = '" & dbname & "'"
logfile.WriteLine date & " " & time & " database before if exist check: " & vbcrlf & sql
Set dataset = sqlcon.Execute(sql)

if dataset("DBCount") = 0 Then
   
   '=== create the sql database
   sql = "CREATE DATABASE [" & dbname &"]"
   logfile.WriteLine date & " " & time & " database before creation query: " & vbcrlf & sql
   set dataset = sqlcon.execute(sql)
else
   logfile.WriteLine date & " " & time & " database already exist " & nom_db
end if

'=== DATABASE === check if database exist after creating it
sql = "SELECT COUNT(*) As 'DBCount' FROM master.dbo.sysdatabases WHERE name = '" & dbname & "'"
logfile.WriteLine date & " " & time & " database after creation if exist check: " & vbcrlf & sql
Set dataset = sqlcon.Execute(sql)

if dataset("DBCount") = 0 Then
   a = date & " " & time & " ERROR FATAL creating database, cannot continue" & vbcrlf & "program ending"
   logfile.WriteLine a
   msgbox(a)
   wscript.quit
end if

'=== DATABASE === use the database by defaut in sql (just in case we forgot to always put full name in all query)
sql = "USE [" & dbname & "]"
Set dataset = sqlcon.Execute(sql)


'=== DATABASE === set permissions
'futur


'=== TABLE === chek if table exist
sql = "SELECT COUNT(*) As 'tabcount' FROM [" & dbname & "].dbo.sysObjects WHERE name = '" & tabname & "'"
Set dataset = sqlcon.Execute(sql)

if dataset("tabCount") = 0 Then
   
   '=== no table === create table with an ID column, identity, autoincrement by 1
   sql = "CREATE TABLE [" & dbname & "].dbo.[" & tabname & "] (id INT IDENTITY (1, 1) PRIMARY KEY, " & tables & ")"
   logfile.WriteLine date & " " & time & " TABLE before creation query: " & vbcrlf & sql
   Set dataset = sqlcon.Execute(sql)
else
   
    '=== table exist

'=== check each column if it exist and create them if not
i=0
tables=""
for each a in aracolnam
  sql = "SELECT COUNT(*) As tableCount FROm [" & dbname & "].dbo.syscolumns "
  sql = sql & "WHERE ID = (SELECT ID from [" & dbname & "].dbo.sysobjects WHERE name='" & tabname & "') AND name = '" & a & "';"
  objOutputFile.WriteLine date & " " & time & " QUERY to check number of column with the name: " & a & vbcrlf & sql
  Set dataset = sqlcon.Execute(sql)
       
       if dataset("tableCount") = 0 Then
           
           '=== add column and type
           objOutputFile.WriteLine date & " " & time & " QUERY to add column: " & a & vbcrlf & sql
           SQL = "ALTER TABLE [" & dbname & "].dbo.[" & tabname & "] ADD " & aracolnam(i) & " " & aratype(i)
           Set dataset = sqlcon.Execute(sql)
       end if
  'aracolnam(i) & " " & aratype(i) & ","
  i=i+1

next

'=== check if there is an identity column

sql = "use ["& dbname & "]" & vbcrlf
sql = sql & "SELECT i.name AS IndexName, OBJECT_NAME(ic.OBJECT_ID) AS TableName, COL_NAME(ic.OBJECT_ID,ic.column_id) AS ColumnName "
sql = sql & "from [" & dbname & "].sys.indexes AS i "
sql = sql & "INNER JOIN [" & dbname & "].sys.index_columns AS ic "
sql = sql & "ON i.OBJECT_ID = ic.OBJECT_ID AND i.index_id = ic.index_id WHERE i.is_primary_key = 1"
objOutputFile.WriteLine date & " " & time & " identity check - check if any colum have identity status: " & vbcrlf & sql
Set dataset = sqlcon.Execute(sql)

primaryfnd=0
While Not (dataset.EOF)

'=== the query list all primary keys, we must check table name

'=== indexname, tablename, columnname
if dataset(1).value = tabname then
  
  '=== primary key found in table but not with the name ID
  primaryfnd = 1

  objOutputFile.WriteLine date & " " & time & " there is a primary key in this table - primaryfnd value: " & primaryfnd

  '=== column name
  a = dataset(2).value
  a = lcase(a)
  
end if
dataset.movenext
Wend


    '=== if a primary key was not found we do not have to check for any ID column at all
    if primaryfnd=0 then
    
  '=== we check for a column named "ID"
  logfile.WriteLine date & " " & time & " TABLE exist we check for id column"
  sql = "SELECT COUNT(*) As tableCount FROm [" & nom_db & "].dbo.syscolumns "
  sql = sql & "WHERE ID = (SELECT ID from [" & nom_db & "].dbo.sysobjects WHERE name='" & nom_table & "') AND name = 'id';"
  objOutputFile.WriteLine date & " " & time & " QUERY to check number of column with the name 'ID': " & vbcrlf & sql
  Set dataset = sqlcon.Execute(sql)
  
  if dataset("idCount") = 0 Then   

 '=== there no column named "id" in the table
 '=== we create it, as identity, but sql wont allow it i think
 sql = "ALTER TABLE [" & dbname & "].dbo.[" & tabname & "] ADD ID INT IDENTITY (1, 1) PRIMARY KEY"
 objOutputFile.WriteLine date & " " & time & " add ID column with identity tag on: " & vbcrlf & sql
 Set dataset = sqlcon.Execute(sql)

  else

 '=== id exist, we must turn its identity flag ON, but sql wont allow it
 '=== create an id column identity
     'sql = "ALTER TABLE [" & dbname & "].dbo.[" & tabname & "] ADD ID INT IDENTITY (1, 1) PRIMARY KEY"
 'objOutputFile.WriteLine date & " " & time & " add ID column with identity tag on: " & vbcrlf & sql
 'Set dataset = sqlcon.Execute(sql)
  end if

   end if
   '=== check if any identity column exist in table
   logfile.WriteLine date & " " & time & " end of table creation ---------------------------------"
   
   '=== create unique constraint
   '=== uc_nom = name of constraint (UC stand for unique constraint)
   '=== columnname = column name
   
   '=== ALTER TABLE [224].[dbo].[groupes] ADD CONSTRAINT uc_nom unique(columnname)
end if

end sub