x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="test2"
arabutdes(x)="test2 my own script"
aradepnam(x)="test"
aradepcol(x)="cccccc"
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)
do '=== already in the code do not put two "do" there!
if resbutlefstr="test2" then
'=== 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"))
fbot.WriteLn("Hello world<br><br>") '=== write hello world in frame
end if
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 and to be able to retrive it in VBS
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
'=== 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
if resbutlefstr="test" 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"
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"))
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="test" then
namtmp(x)="text01" '===== name of variable for programming purpose
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"
end if
'=== 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
'=== Ultimate dynamic web interface 2.0
'=== 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
'============================================== 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)="newdb"
arabutdes(x)="Create new database"
aradepnam(x)="Change"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="edtdb"
arabutdes(x)="Edit database"
aradepnam(x)="Change"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="srcdb"
arabutdes(x)="Search database"
aradepnam(x)="View"
aradepcol(x)="cccccc"
x=x+1
ReDim Preserve arabutnam(x): ReDim Preserve arabutdes(x): ReDim Preserve aradepnam(x): ReDim Preserve aradepcol(x)
arabutnam(x)="test"
arabutdes(x)="test multiple buttons"
aradepnam(x)="test"
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"
'=== old code for ref
'arabut=array("stristas", "striunig", "desarchive", "infocomp", "cretasks", "renamecomputer", "test", "clrframes", "quit01")
'arabutdes=array("Crée Structure i: Stas", "Crée Structure i: Unigec", "Désarchivage", "Info computer", "Create tasks", "Rename computer", "test divers", "Clear Frames", "Quitter")
'aradep=array("All", "All", "Informatique", "Informatique", "Informatique", "Informatique", "Other", "All")
'aradepcol=array("cccccc", "cccccc", "6699ff", "6699ff", "6699ff", "6699ff", "6699ff", "cccccc")
'=== 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)
if resbutlefstr="test" 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 & "   Autoincrement: " & 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 & "   autoincrement 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)
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)
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)
fbot.WriteLn(tabnam)
for each tab in objcat.Tables
If tab.Type = "TABLE" Then
if tabnam = lcase(tab.name) then set objtab=tab
end if
next
'=== list columns in table
for each col in objtab.columns
fbot.WriteLn(c & "<br>Type: " & col.type & "   Autoincrement: " & col.Properties("AutoIncrement") & "<br>")
next
end if
end if
'========================== caca
'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)
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 oie.readystate<>4" & vbcrlf
cc = cc & " wscript.sleep 200" & vbcrlf
cc = cc & "Loop" & vbcrlf
cc = cc & aa & ".WriteLn("" "")" & 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
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(" <b><span style='color:" & col & "'> " & 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="" " & buttmp(ii) & " "">")
fmid.WriteLn("          ")
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>",_
"<meta content=""text/html; charset=utf-8"" http-equiv=""Content-Type"">",_
"<meta http-equiv=""X-UA-Compatible"" content=""IE=8"">",_
"</HEAD>",_
"<FRAMESET id='main' COLS=""13%, *"">",_
"<FRAME SRC=""About:Blank"" NAME=""left"" id=""left"">",_
"<frameset id='main2' rows=""30%,70%"">",_
"<FRAME SRC=""About:Blank"" NAME=""middle"" id=""middle"">",_
"<FRAME SRC=""About:Blank"" NAME=""bottom"" id=""bottom"">",_
"</FRAMESET>", _
"</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
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
'=== 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)
'=== 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
call oieready
'=== print button
priara = array("<input type=""button"" onClick=""javascript:print()"" value=""Print""/><br><br>")
xmax = UBound(aara, 1) 'Returns the Number of columns --- elements in first dimension
on error resume next
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)
fmid.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
'=== 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
'=== tableau html
htmtab = htmtab & "<TR>"
i=0
For Each a In aaratit
'=== columns names
if cc01<>0 then if i=0 then htmtab = htmtab & "<td><p>Select</td>"
htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"
i=i+1
if dimnum=1 then exit for
Next
htmtab = htmtab & "</tr>"
end if
'ara01(x,y) = "ligne1 col1"
'ara01(0,0) = "ligne1 col1"
'ara01(0,1) = "ligne2 col1"
'ara01(1,0) = "ligne1 col2"
'ara01(1,1) = "ligne2 col2"
'=== middle
if mm=1 then
For xx = 0 To xmax
htmtab = htmtab & "<TR>"
if dimnum=2 then
For yy = 0 To ymax
'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""
if yy=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>"
end if
htmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"
Next
else
'=== there is only 1 column
htmtab = htmtab & "<td><p>"
htmtab = htmtab & "<input type=""button"" name=""" & "but" & trim(cstr(xx+1)) & """ value=""" & "Select " & xx+1 & """"
htmtab = htmtab & " style=""background-color: #" & "cccccc" & "; color: #000000;""><br>"
htmtab = htmtab & "</td>"
htmtab = htmtab & "<td><p>" & aara(xx) & "</td>"
end if
htmtab = htmtab & "</tr>" & vbcrlf
Next
end if
'=== footer
if ff=1 then
htmtab = htmtab & "</table></span></b><br>"
end if
htmtab = htmtab & "</form>"
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 xx = 0 To xmax
if dimnum=2 then
For yy = 0 To ymax
if yy=0 and cc01<>0 then
fmid.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("buttonmid")
end if
Next
else
'=== there is only 1 column
fmid.forms(0).elements("but" & trim(cstr(xx+1))).onclick = getref("buttonmid")
end if
Next
end if
set fmid.onkeypress = GetRef("Checkmid")
'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
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (5)
Author
Commented:here is the code:
Open in new window
Author
Commented:(in a few lines of java script)
Author
Commented:Author
Commented:http://wildboy85.blogspot.com/
i am converting all my web interface code from wsh (windows host script) to visual basic 2010
so all the techniques here have been converted
1 using internet explorer as web interface in vb.net
2 using database mdb
3 handling key event
4 handling click event
Author
Commented:Here is the correction you must apply to 3 objects:
Just search for this line:
set flef = oie.document.frames("left"
It's when the frames objects are created
Replace with the code below with a condition if it's explorer 10 or before
Open in new window