@wsh888666wsh

PROBLEM:

问题：

When developping tools to manage simple tasks in an enterprise or a network, I often use vbscripts

当开发工具来管理企业或网络中的简单任务时，我经常使用vbscripts

I wanted a way to centralize all thoses scripts, in a user friendly interface that can zoom, print and copy paste easily

我想要一种在用户友好的界面中集中所有这些脚本的方法，该界面可以轻松缩放，打印和复制粘贴

As a network administrator, I do not have the time to program theses tools in visual basic

作为网络管理员，我没有时间在Visual Basic中对这些工具进行编程

DESCRIPTION:

描述：

That is a VBS script that use internet explorer as user interface, divided in 3 frames

这是一个使用Internet Explorer作为用户界面的VBS脚本，分为3帧

FUNCTIONALITIES:

功能：

right now it's just an interface where you can:

现在，它只是一个界面，您可以在其中：

POSSIBLE USES:

可能的用途：

They are currently in some of my scripts that are not merged yet with this interface

它们当前在我的一些脚本中，尚未与此接口合并

GUIDE TO ADD A SCRIPT IN THIS INTERFACE:

在此界面中添加脚本的指南：

1.为您的脚本添加一个按钮 (1. add a button for your script)

第一部分是添加一个按钮来调用您的脚本，可以在这里完成：（大约86行）

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"

when the button is added, the script will automatically generate it in internet explorer when run

添加按钮后，脚本将在运行时在Internet Explorer中自动生成

2.添加脚本 (2. add script)

第二部分是添加您想要按钮运行的子目录/脚本，让我们说按钮“您好，世界！

we will scroll to the section starting in line 176 approx here is the line to look for:

我们将滚动到第176行开始的部分，大约是要查找的行：

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)

so, after the DO we add the sub we want to execute by pressing the button:

因此，在DO之后，我们通过按按钮添加要执行的子项：

when you press the test2 button, the resbutlefstr will contain the text "test2"

当您按下test2按钮时，resbutlefstr将包含文本“ test2”

before the code is executed, we must clear resbutlefstr and the frames or the main loop will act like if the button was still pressed

在执行代码之前，我们必须清除resbutlefstr，并且框架或主循环的行为类似于是否仍然按下按钮

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 framesa = clefra(array("fmid","fbot"))fbot.WriteLn("Hello world<br><br>") '=== write hello world in frameend if

after hello world is displayed, nothing will happen until you press another button in the control frame (left)

在显示hello world之后，直到您按控制框架中的另一个按钮（左），一切都不会发生

3.输入表单如何工作 (3. How does the input form work)

第三部分是解释输入表单生成器的工作方式

as you can see in the other subs executed by the buttons, there is also a form ready to input something to process something more complicated than "hello world"

如您在按钮执行的其他子程序中看到的那样，还有一种表单可以随时输入内容，以处理比“ hello world”更复杂的内容

The sub to call to generate this from is called:

要从中生成此信息的子调用称为：

dynforgen dynamic form generator

dynforgen动态表单生成器

It's input are:

它的输入是：

      x=0redim 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 fieldnamtmp(x)="dbnam"                 '===== name of variable for programming purpose and to be able to retrive it in VBSdeftmp(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

Each element of this matrix will be an input field, that have a name and it's value can be accessed in the vbs script after the user

该矩阵的每个元素将是一个输入字段，其名称和名称可以在用户输入后通过vbs脚本进行访问。

entered something and pressed "ok" (string value "ok" in resbutmidstr or "enter" (code 13) in reskeymid

输入一些内容并在resbutmidstr中按“ ok”（字符串值“ ok”）或在reskeymid中按“ enter”（代码13）

Some sub are premade to "scan" button values and keyboard values in the internet exploer object and put them in the results variables reskeymid and resbutmidstr

预先制作了一些子控件，以“扫描” Internet Explorer对象中的按钮值和键盘值并将它们放入结果变量reskeymid和resbutmidstr

a sub have been programmed for each frame and each event (button and key)

为每个帧和每个事件（按钮和键）编程了一个子程序

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

4.如何插入表格并使用其输入值 (4. How to insert a form and use it's input value)

第四部分是插入代码以输入内容然后显示它

Finally, here is the code we have to insert to make a better "Hello World" with an input from the user:

最后，这是我们必须插入的代码，以通过用户输入来创建更好的“ Hello World”：

   if resbutlefstr="test" then'=== this was a test with multiple button value (one for each line)a = clefra(array("fmid","fbot"))x=0redim 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 fieldnamtmp(x)="text01"                  '===== name of variable for programming purposedeftmp(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 keywordsbuttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" buttona = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)do'=== flag to tell if the input is not validerr01=0'=== flag to say input is done, since there might be a defaut value, we must validate if user was finishedinpdon=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 valuestext=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for inputif len(text) < 1 thenerr01=1'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)if len(text) < 1 thenerrtmp(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 reda = 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 continuereskeymid=0resbutmidstr=""else'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loopinpdon=1err01=0end ifend ifwscript.sleep 100'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorerif resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then'=== if user pressed escape or cancel, we clear the framesif resbutmidstr="cancel" or reskeymid=27 thena = clefra(array("fmid","fbot"))end ifexit doend if'=== if there was an input error and no one used left control frame to exit, we keep asking for inputloop 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 frameif bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" thenfbot.WriteLn(text & "<br>")end ifreskeymid=0resbutmidstr=""end if

I know this is a bit complicated for a beginner, but a simple copy paste to make another operation is not really hard once you have a base in VB

我知道对于初学者来说这有点复杂，但是一旦在VB中有了基础，简单的复制粘贴就可以进行其他操作并不难。

Here are the main lines to change:

以下是要更改的主要内容：

Here is the name of the button that will make the action happen:

这是将使操作发生的按钮的名称：

if resbutlefstr="test" then

Name of the variable that will containt the text result from the interface:

将包含来自接口的文本结果的变量的名称：

namtmp(x)="text01"                  '===== name of variable for programming purpose

Code where we will get this result to validate it: (text01)

我们将获得此结果以对其进行验证的代码：（text01）

text=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for input

Length validation and error message (errtmp(0), matrix element 0 for error message is for the first box, 1 for second etc)

长度验证和错误消息（errtmp（0），错误消息的矩阵元素0用于第一个框，1代表第二个框等）

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

And finally the action to do after all input are done and validated: (and there is nothing that hapenned before, like a cancel or closing internet explorer)

最后，完成并验证所有输入后要执行的操作：（并且之前没有发生任何中断，例如取消或关闭Internet Explorer）

      '=== if internet explorer was not closed (bready), a button was not pressed on left frame, and no excape or cancel in middle frameif bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" thenfbot.WriteLn(text & "<br>")end if

CHANGE LOG:

变更记录：

2010-04-12 added some delay in internet explorer operation (frame clear) it was making ie crash

2010-04-12在Internet Explorer的运行（框架清除）中添加了一些延迟，这使其崩溃

2010-04-10 correction in the input loop, left frame now have a better control

2010-04-10在输入循环中进行校正，现在左框有更好的控制

2010-04-09 added dabatase creation with a masterkey based on an integer column autoincrement

2010-04-09使用基于整数列自动增量的万能键添加了dabatase创建

'=== 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 7Set 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 systema = """" & a64 & """ """ & basedir & filnam & """"objshe.Run a,0, falsewscript.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 startif 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<>4wscript.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=falseresbutlefstr = ""resbutmidstr = ""resbutbotstr = ""reskeylef = 0reskeymid = 0reskeybot = 0WScript.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=0redim 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 fieldnamtmp(x)="text01"                  '===== name of variable for programming purposedeftmp(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 keywordsbuttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" buttona = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)do'=== flag to tell if the input is not validerr01=0'=== flag to say input is done, since there might be a defaut value, we must validate if user was finishedinpdon=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 valuestext=fmid.form01.text01.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for inputif len(text) < 1 thenerr01=1'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)if len(text) < 1 thenerrtmp(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 reda = 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 continuereskeymid=0resbutmidstr=""else'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loopinpdon=1err01=0end ifend ifwscript.sleep 100'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorerif resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then'=== if user pressed escape or cancel, we clear the framesif resbutmidstr="cancel" or reskeymid=27 thena = clefra(array("fmid","fbot"))resbutmidstr="cancel"end ifexit doend if'=== if there was an input error and no one used left control frame to exit, we keep asking for inputloop 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 frameif bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" thenfbot.WriteLn(text & "<br>")end ifreskeymid=0resbutmidstr=""end ifif 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 framesa = 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" buttonx=0redim 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 fieldnamtmp(x)="dbnam"                 '===== name of variable for programming purposedeftmp(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 keywordsx=x+1redim 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 fieldnamtmp(x)="tabnam"                 '===== name of variable for programming purposedeftmp(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 keywordsbuttmp=array("ok","cancel")       '===== at the end, there will be an "ok" button and a "cancel" buttona = 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 finishedinpdon=0err01=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 valuesdbnam = fmid.form01.dbnam.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for inputdbnam=lcase(dbnam)tabnam = fmid.form01.tabnam.Value '=== namtmp is the variable name used earlier,before we call the dynamic form generation for inputtabnam=lcase(tabnam)if len(dbnam) < 1 or len(tabnam)<1 thenerr01=1'=== error message for the first form (if the keyword "error" is in this string, its displayed in RED)if len(dbnam) < 1 thenerrtmp(0)="error - name must be 1 char long at least"else errtmp(0)="ok"end ifif len(tabnam) < 1 thenerrtmp(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 reda = dynforgen(distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)reskeymid=0resbutmidstr=""else'=== the input was validated, we flag err01 to none, and flag inpdon to exit the loopinpdon=1err01=0end ifend ifwscript.sleep 100'=== while we wait for input value, user can press "escape" key, "cancel" button or close internet explorerif resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then'=== if user pressed escape or cancel, we clear the framesif resbutmidstr="cancel" or reskeymid=27 thena = clefra(array("fmid","fbot"))resbutmidstr="cancel"end ifexit doend if'=== if there was an input error and no one used left control frame to exit, we keep asking for inputloop while err01<>0 or inpdon=0'===  if bready=false and resbutlefstr="" and reskeymid<>27 and resbutmidstr<>"cancel" then'=== all value were validated, we continuedbnam = dbnam & ".mdb"'=== chek if the file already existSet objFolder2 = objFSO.GetFolder(basedir)'=== dirSet objFiles2 = objFolder2.files '=== fichiersfound=0For Each objFile3 in objFiles2nomfile=objfile3.namenomfile=lcase(nomfile)if nomfile=dbnam thenfound=1end ifnext  if found=1 thena = 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=" & dbnamobjcon.open constrobjcat.activeconnection=(objcon)for each tab in objcat.TablesIf tab.Type = "TABLE" Thenfbot.WriteLn("<br>TABLES:<br><br>")fbot.WriteLn(tab.name & "<br>")fbot.WriteLn("<br>COLUMNS:<br><br>")for each col in tab.columnsc = lcase(col.name)fbot.WriteLn(c & "<br>Type: " & col.type & "&nbsp&nbsp&nbspAutoincrement: " & col.Properties("AutoIncrement") & "<br>")nextend ifnextobjcon.closeset objcat=nothingset objcon=nothingelsea = clefra(array("fmid"))'=== formats: jet10 = 1 Jet11 = 2 Jet20 = 3 Jet3x = 4 Jet4x = 5 (Access 2000)Dim Catalogfbot.WriteLn("Creation ADOX catalog (adox.dll, access required)<br><br>")Set objcat = CreateObject("ADOX.Catalog")format = 5fbot.WriteLn("database creation: " & dbnam & "<br><br>")constr="Provider=Microsoft.Jet.OLEDB.4.0;" & "Jet OLEDB:Engine Type=" & Format & ";Data Source=" & dbnamobjcat.Create constr'=== add a table in the databasefbot.WriteLn("table creation: " & tabnam &"<br>")Set objtab = CreateObject("ADOX.table")objtab.name = tabnamobjcat.Tables.Append objtabobjcat.Tables.refresh'=== add a columns in the only existing tablefor each tab in objcat.TablesIf tab.Type = "TABLE" Thenfbot.WriteLn("table existing: " & tab.name & "<br>")'=== add column in databaseSet objcol = NothingSet objcol = CreateObject("ADOX.Column")'typdat=202   '=== string adVarWChar'maxlen=250'typdat=131   '=== float adnumeric'maxlen=10typdat=3     '=== integer adintegermaxlen=10if typdat=3 then a="adinteger"if typdat=202 then a="adVarWChar"if typdat=131 then a="adnumeric"colnam="codint"objcol.name = colnamobjcol.type = typdatif typdat = 3 or typdat = 202 then objcol.DefinedSize = maxlenif typdat=3 then'=== must set parent catalog before setting autoincrementSet objcol.ParentCatalog = objcatobjcol.Properties("AutoIncrement")=trueend ifelseif typdat = 131 thenobjcol.precision = 28objcol.numericscale = 8end iffbot.WriteLn("column creation: " & colnam & "<br>")Tab.Columns.Append objcolfbot.WriteLn("primary key creation: " & colnam & "<br>")Set objkey = CreateObject("ADOX.key")objkey.name="Primary"objkey.columns.append colnamtab.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 indexfor each col in tab.columnsc = lcase(col.name)fbot.WriteLn("column existing: " & c & "&nbsp&nbsp&nbspautoincrement status: " & objcol.Properties("AutoIncrement") & "<br>")nextend ifnextset objcat=nothingfbot.WriteLn("<br>You database have been created with 1 table and a defaut column named " & colnam & "<br>")   fbot.WriteLn("<br>END<br>")end ifelse'msgbox(resbutlefstr & "   " & resbutmidstr & "   " & resmidkey & "   " & bready)'===end ifreskeymid=0resbutmidstr=""dbnam=""end if'===========================if resbutlefstr="edtdb" thenresbutlefstr = ""a = clefra(array("fmid","fbot"))'=== value'=== chek if the file already existSet objFol01=objFSO.GetFolder(basedir)'=== dirSet objfol02=objFol01.files '=== filesx=0redim ara01(0)dimnum=1For Each objFil in objFol02filnam=objfil.namefilnam=lcase(filnam)if right(filnam,4)=".mdb" thenredim preserve ara01(x)ara01(x)=filnamx=x+1end ifnext'=== title of the columnsaratit = array("Name of the database")'=== array to put in table, choice button, header, middle line, bottom line, reloada = dynbotcho(fmid, "choose the database to edit", aratit, ara01, 1 ,1, 1, 1, 1)dowscript.sleep 100'=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorerif resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then'=== if user pressed escape or cancel, we clear the framesif resbutmidstr="cancel" or reskeymid=27 thena = clefra(array("fmid","fbot"))resbutmidstr="cancel"end ifexit doend 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 databaseSet objcat = CreateObject("ADOX.Catalog")Set objcon = nothingSet objcon = CreateObject("ADODB.Connection") constr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbnamobjcon.open constrobjcat.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 edita = clefra(array("fmid","fbot"))aratit=array("Table name")x=0redim ara01(0)for each tab in objcat.TablesIf tab.Type = "TABLE" Thenc = lcase(tab.name)redim preserve ara01(x)ara01(x)=cx=x+1end ifnexta = dynbotcho(fmid, "Choose the table to edit", aratit, ara01, 1 ,1, 1, 1, 1)dowscript.sleep 100'=== while we wait for input value (or button press), user can press "escape" key, "cancel" button or close internet explorerif resbutmidstr="cancel" or reskeymid=27 or bready=true or resbutlefstr<>"" then'=== if user pressed escape or cancel, we clear the framesif resbutmidstr="cancel" or reskeymid=27 thena = clefra(array("fmid","fbot"))resbutmidstr="cancel"end ifexit doend 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.TablesIf tab.Type = "TABLE" Thenif tabnam = lcase(tab.name) then set objtab=tabend ifnext'=== list columns in tablefor each col in objtab.columnsfbot.WriteLn(c & "<br>Type: " & col.type & "&nbsp&nbsp&nbspAutoincrement: " & col.Properties("AutoIncrement") & "<br>")nextend ifend if'========================== caca'msgbox("exit on left button" & resbutlefstr)'resbutlefstr = ""resbutmidstr = ""resbutbotstr = ""reskeylef = 0reskeymid = 0reskeybot = 0end ifif resbutlefstr="srcdb" thenend ifif 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 sectionfbot.WriteLn("<html><body>TEST mid section")fbot.WriteLn("<html><body><form method='post' name='form1'>")butnam = "buttonbot"for ii=0 to 10fbot.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>")nextfbot.WriteLn("</form>")fbot.WriteLn("</html>")fbot.WriteLn("</body>")for ii=0 to 10fbot.forms(0).elements(butnam & ii).onclick = getref("buttonbot")next'=== loop until a button is pressed on left frame or ie is closeddowscript.sleep 100if resbutbotstr<>"" thenfmid.WriteLn(resbutbotstr)resbutbotstr=""end ifloop while resbutlefstr="" and bReady=false'=== ie is still open and but come button was pressed on left frameif bready=false and resbutlefstr<>"" then'=== we remove the actions on the buttonsfor ii=0 to 10fbot.forms(0).elements(butnam & ii).onclick = nothingnext'=== clear frames, reset button value and keyvalueif resbutlefstr<>"quit01" thena = clefra(array("fmid","fbot"))end ifend ifend if'=== desarchivage (move files from archives to temp folder and pop outlook message)'=== here as reference onlym not working, missing a subif resbutlefstr= "desarchive" thentit="Désarchivage"'=== refresh menu (chek button = 0)a = clefra(array("fmid","fbot"))'=== inputs to do before processingdistmp=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)doerr01=0if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then '=== User has clicked the OK button, retrieve the valuesconnum = fmid.form01.connum.Valueif len(connum) < 5 thena = "error - contrat doit avec 5 caractères"err01=1errtmp(2)=aa = dynforgen (distmp,namtmp,deftmp,typtmp,errtmp,buttmp,tit)end ifend ifwscript.sleep 100if resbutmidstr="cancel" or reskeymid=27 then exit doloop while (err01<>0 and resbutlefstr="") or (connum="" and resbutlefstr="")if resbutlefstr="" and (resbutmidstr="ok" or reskeymid=13) then'=== doing the job, all input are okclefra(array("fmid"))a = desarchive2(connum,fbot)fbot.WriteLn("done<br>")resbutmidstr=""reskeymid=0elseif resbutlefstr="" and (resbutmidstr="cancel" or reskeymid=27) then'=== nothing was pressed on left, but cancel was used or escapea = clefra(array("fmid","fbot"))elseif resbutlefstr<>"" then'=== sometthing hapenned with the buton on the left side (menu/control)a = clefra(array("fmid","fbot"))end ifend 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 thenoie.quitset 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 databaseCreateNewMDB basedir & "test.mdb", 5'=== list of tables to createalltab(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 CatalogSet 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 aaracc = cc & "Do While (oIE.Busy) " & vbcrlfcc = cc & "   wscript.sleep 200" & vbcrlfcc = cc & "Loop" & vbcrlfcc = cc & "Do While oie.readystate<>4" & vbcrlfcc = cc & "   wscript.sleep 200" & vbcrlfcc = cc & "Loop" & vbcrlfcc = cc & aa & ".location.reload(true)" & vbcrlfcc = cc & "Do While (oIE.Busy) " & vbcrlfcc = cc & "   wscript.sleep 200" & vbcrlfcc = cc & "Loop" & vbcrlfcc = cc & "Do While oie.readystate<>4" & vbcrlfcc = cc & "   wscript.sleep 200" & vbcrlfcc = cc & "Loop" & vbcrlfcc = cc & aa & ".WriteLn(""&nbsp;"")" & vbcrlfcc = cc & aa & ".location.reload(true)" & vbcrlfcc = cc & "Do While oie.readystate<>4" & vbcrlfcc = cc & "   wscript.sleep 200" & vbcrlfcc = cc & "Loop" & vbcrlfcc = cc & "Do While (oIE.Busy) " & vbcrlfcc = cc & "   wscript.sleep 200" & vbcrlfcc = cc & "Loop" & vbcrlfnextexecute 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 = 0reskeymid = 0reskeybot = 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 itfmid.WriteLn("<h3><span class=SpellE>" & title & "</span></h3>")'=== default focus on empty field (with no default value)deffoc=0for ii=0 to ubound(namtmp)if deftmp(ii)="" thenif instr(lcase(errtmp(ii)),"facultatif")=0 thenfmid.WriteLn("<BODY onLoad=""document.form01." & namtmp(ii) & ".focus()"">")deffoc=1end ifend if'=== no default value empty, we focus on first fieldnextif deffoc=0 thenfmid.WriteLn("<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">")end iffmid.WriteLn("<div class=MsoNormal align=center style='text-align:center'>")fmid.WriteLn("</div>")fmid.WriteLn("<form name=form01>")'=== button and error messagefor 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 controlfmid.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 thencol="red"elsecol="blue"end iffmid.WriteLn("&nbsp; <b><span style='color:" & col & "'>&nbsp" & errtmp(ii) & "</span></b><br style='mso-special-character:line-break'>")nextfmid.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")nextfmid.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 formfor ii=0 to ubound(buttmp)Do While (oIE.Busy)wscript.sleep 100loopdo while oie.readystate<>4wscript.sleep 100Loop'=== value to return for each button in the formfmid.forms(0).elements(buttmp(ii)).onclick = getref("buttonmid")next'=== regenerate the event that call a sub if a button is pressedset fmid.onkeypress = GetRef("Checkmid") '=== clear button pressed and key pressed for this frameresbutmidstr=""reskeymid=0
end function'===  max
Function max(a, b)If a > b Then max = a Else max = b
End Functionfunction 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 programoie.FullScreen = False
'.ToolBar   = False
'.StatusBar = False
'.Navigate("About:Blank")
'.visible = trueoIE.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<>4wscript.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 accessset flef = oie.parent.document.getElementByid("left").contentdocumentset fmid = oie.parent.document.getElementByid("middle").contentdocumentset fbot = oie.parent.document.getElementByid("bottom").contentdocument
elseset flef = oie.document.frames("left").documentset fmid = oie.document.frames("middle").documentset 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 onlyif ((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=iif i>ubound(aradepnam) theni2=ubound(aradepnam)elsea=aradepnam(i2)end ifif a<>lasdep then'=== new departement nameflef.WriteLn( "<br>" & a & "<br>")lasdep=a       end ifb = b & " style=""background-color: #" & aradepcol(i2) & "; color: #000000;""><br>"flef.WriteLn(b)end if
nextflef.WriteLn("</form>")
flef.WriteLn("</body>")
flef.WriteLn("</html>")'=== we dont refresh this frame, its the first oneend function'=== sub to call when something is pressed
'=== called for many buttons, return the button name or a keyboard code (Ascii)
sub buttonlefset src = flef.parentWindow.event.srcElementresbutlefstr = src.name
end subsub buttonmidset src = fmid.parentWindow.event.srcElementresbutmidstr = src.name
end subsub buttonbotset src = fbot.parentWindow.event.srcElementresbutbotstr = src.name
end subsub Checklefreskeylef = flef.parentWindow.event.keycode
end subsub Checkmid reskeymid = fmid.parentWindow.event.keycode
end subsub Checkbotreskeybot = 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 '=== fichiersfound=0  '=== fichier de rapport pas trouve
For Each objFile3 in objFiles2nomfile =objfile3.namenomfile= lcase(nomfile)next  end function'=== delete a table in a databasefunction tabdel()for each tab in objcat.TablesIf tab.Type = "TABLE" Thenb=lcase(tab.name)'=== object.delete not supported, so we delete with nameobjcat.tables.delete bfbot.WriteLn("delete: " & b & "<br>")  END IFnextend function'=== for reference
function dynbotcho00i3=0For each dia01 in choicearasql = makque(dia01,tab,sel,whe,"","=","")a = exesql(objcon,tag,sql)'=== make same array for a multiples queriesif tag.eof=0 then'a = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3if ubound(choiceara)=0 and i3=0 thena = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,1,1) '=== 1 2 3elseif i3=0 then'=== headera = dynbotcho("DIAGNOSTIC",tag,0,sql,1,1,0,0) '=== 1 2 3elseif i3<>ubound(choiceara) and i3<>0 then'=== footera = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,0,0) '=== 1 2 3elseif i3=ubound(choiceara) thena = dynbotcho("DIAGNOSTIC",tag,0,sql,0,1,1,1) '=== 1 2 3end ifi3 = i3 + 1else'=== 0 resultsa = nores(sql)end ifnext
end functionfunction 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 endcall oieready'=== print buttonpriara = array("<input type=""button"" onClick=""javascript:print()"" value=""Print""/><br><br>")xmax = UBound(aara, 1) 'Returns the Number of columns  --- elements in first dimensionon error resume nextymax = UBound(aara, 2) 'Returns the Number of rows     --- elements in second dimension'=== number of dimensions in case there is only 1 columnif err<>0 thendimnum=1elsedimnum=2end ifon error goto 0'=== web script for buttons to return the number of the button that was pressed'=== print buttonif hh=1 thenfor each a in priaraffra.WriteLn(a)fmid.WriteLn("<form name=form01>")'ffra.WriteLn("<BODY onLoad=""document.form01." & namtmp(0) & ".focus()"">")nextend if'=== select buttonsif cc01<>0 then '=== buttons var only if select is activeif cc01<>0 thenfor yy=0 to ymaxnextend ifend if'=== headerif hh=1 thenhtmtab = 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 htmlhtmtab = htmtab & "<TR>"i=0For Each a In aaratit'=== columns namesif cc01<>0 then if i=0 then htmtab = htmtab & "<td><p>Select</td>"htmtab = htmtab & "<td><p>" & Trim(a) & "</td>"i=i+1if dimnum=1 then exit forNexthtmtab = 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"      '=== middleif mm=1 thenFor xx = 0 To xmaxhtmtab = htmtab & "<TR>"if dimnum=2 thenFor yy = 0 To ymax'If IsNull(myarray(xx, yy)) Then myarray(xx, yy) = ""if yy=0 and cc01<>0 thenhtmtab = 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 ifhtmtab = htmtab & "<td><p>" & aara(yy, xx) & "</td>"Nextelse'=== there is only 1 columnhtmtab = 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 ifhtmtab = htmtab & "</tr>" & vbcrlfNextend if'=== footerif ff=1 thenhtmtab = htmtab & "</table></span></b><br>"end ifhtmtab = htmtab & "</form>"ffra.WriteLn(htmtab)'=== reload (will not reload if we are in middle of a muliple elements/query table)if rr=1 thenffra.location.reload(true)call oiereadyend ifif mm=1 thenFor xx = 0 To xmaxif dimnum=2 thenFor yy = 0 To ymaxif yy=0 and cc01<>0 thenfmid.forms(0).elements("but" & trim(cstr(yy+1))).onclick = getref("buttonmid")end ifNextelse'=== there is only 1 columnfmid.forms(0).elements("but" & trim(cstr(xx+1))).onclick = getref("buttonmid")end ifNextend ifset fmid.onkeypress = GetRef("Checkmid")'for i=0 to ubound(arabutnam)'   flef.forms(0).elements(arabutnam(i)).onclick = getref("buttonlef")'next
end functionsub oieready()do while oie.readystate<>4wscript.sleep 100loopDo While (oIE.Busy) wscript.sleep 100Loop
end sub

翻译自: https://www.experts-exchange.com/articles/1053/web-interface-for-wsh-vbs-vbscript.html

@wsh888666wsh