Content Type
Profiles
Forums
Events
Everything posted by gunsmokingman
-
.vbs (cancel within html)
gunsmokingman replied to drfb's topic in Programming (C++, Delphi, VB/VBS, CMD/batch, etc.)
1:\ How do i get it to open programs etc when the counter gets to a certain # (seconds)? You would have to add something like EX Dim Act :Set Act = Createobject("Wscript.Shell") to be able to run objects. In the Counter function something like this Ex If Ct = 60 Then Do Something to run or display things at certain points threw the script. 2:\ If i gave you a copy of my coding (.vbs) do you think you could assist in changing it into .hta? Post your code and I will help you adjust it to work within the HTA. Download the demo I posted in the above post. -
I could be wrong but 1:\strsUsername varible name you are trying to pass 2:\&sUsername& varible name in script 3:\&sUsername& varible name in script would cause the script to use a varible that does not have any information. Here is a script that prevents the Input from being close using the Cancel Button or the X and only process the Input if it 2 characters or longer. The only thing I have not tested is the Takeown and RoboCopy, the rest of the script runs without errors. UserIn_Takeown_RoboCopy.vbs '-> This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use.'-> This is only posted as example code and meant only to used as such.Dim Act :Set Act = CreateObject("Wscript.Shell")Dim UserGetInput()Function GetInput()User = InputBox(_"Type in the target User Name" & vbCrLf & vbCrLf & _"To exit or quit type Exit or Quit","","",6500,5500)If User <> "" And Len(User) >= 2 Then'->Make Sure Input More Then 2 CharactersIf InStr(LCase(User),"exit") Or _InStr(LCase(User),"quit") Then'-> Exit Or Quit ScriptWScript.Quit()Else'-> Code Here For TakeownAct.Run("takeown.exe /F C:\users\" & User),0,True'-> Code Here For RoboCopyAct.Run("robocopy.exe c:\users\" & User & _" c:\local\profilebackup\localprofile /e /zb /R:3 /W:2")0,True'-> End Of Script Popup Will Self Close In 5 SecondsAct.Popup "Script Completed",5,"Finshed",4128End IfElse'-> To Disable Red X,Cancel And Prevent No Text,And Less 2 CharactersMsgBox vbtab & "Error" & vbcrlf & vbcrlf & _"The Cancel, Red X have been disable" & vbCrLf & _"or no Text was filled in or less then 2" & vbCrLf & _"characters where inputted",4128,"Error"GetInput()End IfEnd Function
-
Another way of opening Explorer.exe CreateObject("Wscript.Shell").Run("explorer.exe D:\"),1,False Perhaps change this area End If End Function </SCRIPT> To this End If CreateObject("Wscript.Shell").Run("explorer.exe D:\"),1,False window.close End Function </SCRIPT> The above code will open Explorer without waiting for the Explorer to be closed, it will then close the HTA. So you should be left with the Explorer window open.
-
I dont know if this is what he wants, but this hides the cmd promt window, just drag and drop any file notepad can open, Dim C34 :C34=Chr(34) If WScript.Arguments.Count = 1 Then CreateObject("Wscript.Shell").Run("%Comspec% /C @Echo Off && Start " & _ C34 & "" & C34 &"/Wait Notepad.exe " &WScript.Arguments(0)),0,True End If Notepad.vbs in Cmd promt, open the text file
-
Here is a HTA that has the doc edit in it script, this still does copy Offerte.doc and factuur.vbs but you can edit it out. Then it opens the user input.doc, waits for it to close then it changes the text. Now this is what you call auto, user gives name, user name doc open, closes user name doc, update text changes. <!--February-06-13 Hta And Script By Gunsmokingman Aka Jake1Eye This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use. This is only posted as example code and meant only to used as such.--><TITLE>UserInput MkDir3</TITLE><HTA:APPLICATION ID="InMkDir3"SCROLL="No"SCROLLFLAT ="No"SingleInstance="Yes"ShowInTaskbar="No"SysMenu="No"MaximizeButton="No"MinimizeButton="No"Border="Thin"BORDERSTYLE ="complex"INNERBORDER ="No"Caption="Yes"WindowState="Normal"APPLICATIONNAME="InMkDir2"Icon="%SystemRoot%\explorer.exe"><STYLE type="text/css">Body{Font-Size:9.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;BackGround-Color:#EFE9E3;Text-Align:Center;Vertical-Align:Top;}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}.Tbx{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}BUTTON{Height:15pt;width:60pt;Cursor:Hand;Font:8.05pt;Font-weight:bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:#404040;Text-Align:Center;Vertical-Align:Middle;filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#E5E5E5',EndColorStr='#7D7D7D');Margin:1;Margin-Top:15pt;Padding:2;Border-Left: 1px Transparent;Border-Right: 2px Transparent;Border-Top: 1px Transparent;Border-Bottom: 2px Transparent;}</STYLE><script LANGUAGE='VBScript'>'-> Resize And Place In Approx Center Of ScreenDim Wth, Hht :Wth = int(475) :Hht = int(225)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))'-> Run Time ObjectsDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> RunTime VariblesDim F1, F2, F1a, F2a, Msg1, Tm1, UserDocMsg1=". The Textboxes Have Been Disable, Contact The " & _"System Admin To Get The Missing Files"F1a="offerte.doc"F2a="factuur.vbs"Function Window_OnLoad()'-> Check To Make Both Files ExistsCheckFile(F1a)CheckFile(F2a)If F1 = True And F2 = True ThenTx1.style.visibility = ""Tx1.style.color="#117711"Tx1.innerHTML = "Confirm " & F1a & " Confirm " & F2aElseIf F1 = True And F2 = False ThenDisableTextBoxes()Tx1.innerHTML = "Confirm " & F1a & " Missing " & F2a & Msg1ElseIf F1 = False And F2 = True ThenDisableTextBoxes()Tx1.innerHTML = "Missing " & F1a & " Confirm " & F2a & Msg1ElseIf F1 = False And F2 = False ThenDisableTextBoxes()Tx1.innerHTML = "Missing " & F1a & " Missing " & F2a & Msg1End IfEnd Function'-> Checks For FilesFunction CheckFile(F)If Fso.FileExists(F) And F=F1a Then F1 = TrueIf Fso.FileExists(F) And F=F2a Then F2 = TrueEnd Function'-> If Any File Is Missing Disable The TextBoxFunction DisableTextBoxes()Tx1.style.visibility = ""Tx1.style.Bottom = 35Tx1.style.Left = 40Tx1.style.width = 375Tx1.Align="Left"Tx1.style.color="#980000"In1.disabled = TrueIn2.disabled = TrueEnd Function'-> Process The Submit ButtonFunction MySubmit()Tx1.style.color="#980000"If Len(In1.value) = 1 And Len(In2.value) >= 3 ThenTx1.style.color="#117711" :Tx1.style.Bottom = 35Tx1.innerHTML = "Confirm, Processing Information<BR>" & _UCase(In1.value) & " " & In2.valueDisplay()ElseIf Len(In1.value) = 0 And Len(In2.value) = 0 ThenTx1.innerHTML = "Error, Fill In Both Textboxes"ElseIf Len(In1.value) = 1 And Len(In2.value) = 0 ThenTx1.innerHTML = "Error, Fill In Full Name"ElseIf Len(In1.value) = 1 And Len(In2.value) <= 3 ThenTx1.innerHTML = "Error, Full Name Less Then 3 Characters"ElseIf Len(In1.value) = 0 And Len(In2.value) >= 3 ThenTx1.innerHTML = "Error, Single Letter Missing"End IfEnd Function'-> Process The InformationFunction ProcessMySubmit()If Fso.DriveExists("H:\") Then'-> Make First FolderDim P [img=http://www.msfn.org/board/public/style_emoticons/default/tongue.gif]="H:\" & UCase(In1.value)If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)'-> Make Second FolderP = P & "\" & In2.valueIf Not Fso.FolderExists(P) Then Fso.CreateFolder(P)'-> Copy Rename offerte.doc And Get The Path And New NameSet F=Fso.GetFile(F1a)UserDoc = P & "\" & Replace(F1a,Left(F1a,7),In2.value)F.Copy P & "\" & Replace(F1a,Left(F1a,7),In2.value),True'-> Copy factuur.vbsSet F=Fso.GetFile(F2a)F.Copy P & "\" & F.Name,TrueEnd IfMsgDisplay()End Function'-> Time Dealy Then CloseFunction Display()Tm1=window.setTimeout("Process1()",2000,"VBScript")End FunctionFunction Process1()window.clearTimeout(Tm1)ProcessMySubmit()End Function'-> Time Dealy Then CloseFunction MsgDisplay()Tx1.style.color="#3377AD"Tx1.style.Bottom = 39Tx1.style.Left = 30Tx1.style.width = 395'-> Open User Input DocAct.Run(Chr(34) & UserDoc & Chr(34)),1,TrueTx1.innerHTML = "Starting To Update : " & In2.value & ".doc"Tm1=window.setTimeout("ProcessFinished()",3000,"VBScript")End FunctionFunction ProcessFinished()'-> Add New TextDim oWord :Set oWord = CreateObject("Word.Application")set oDoc = oWord.Documents.Open(UserDoc)With oWord.Selection.Find.Text = "Offerte".Find.Replacement.Text = "Factuur".Find.Forward = True.Find.MatchWholeWord = True.Find.Execute ,,,,,,,,,,2.Find.Text = "Na eventuele accordatie stellen wij betaling per pin op prijs.".Find.Replacement.Text = "Wij danken u voor uw opdracht, graag betaling via PIN.".Find.Forward = True.Find.MatchWholeWord = True.Find.Execute ,,,,,,,,,,2End WithoDoc.SaveoDoc.CloseoWord.Quitwindow.clearTimeout(Tm1)window.close()End Function</SCRIPT><BODY><!-- Folder Letter --><TABLE Border='1'><TD Style='Width:385;Text-Align:Left;'>Please Type In A Single Letter From A-Z</TD><TD Style=''><INPUT Type='TextBox' ID='In1' Class='Tbx' Size='1' MAXLENGTH='1'></TD></TABLE><!-- User Name --><TABLE Border='1'><TD Style='Width:325;Text-Align:Left;'>Type In Your Full Name</TD><TD Style=''><INPUT Type='TextBox' ID='In2' Class='Tbx' Size='35' MAXLENGTH='128'></TD></TABLE><BUTTON ID='Bn1' OnClick='MySubmit()'>Submit</BUTTON><BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON><!-- For Positioning The Tx1 Div Small And Large Text<DIV Style='Width:275;'>Confirm offerte1.doc Confirm factuur.vbs.</DIV><DIV Style='Width:375;Margin-Top:22pt;Text-Align:Left;'>Missing offerte1.doc Confirm factuur.vbs. TheTextboxes Have Been Disable, Contact The System Admin ToGet The Missing Files</DIV>--><DIV ID='Tx1' Style='visibility:hidden;Position:Absolute;Bottom:49;Left:90;Width:275;'></DIV></BODY>
-
Dim UserIn UserIn = InputBox("Some Text For Some Thing") If UserIn <> "" Then WScript.Echo "User Input : " & UserIn Else WScript.Echo "User Cancel Or No Text Filled In,Or" & vbCrLf & _ "The Red X Was Pressed" End If Some thing so simple as a if statement and it a better script. But then again I am not your boss, so I dont have to worry about any problems.
-
You do know that if they close that inputbox without any input, the script will name the filles, _offerte.doc. Which is very bad coding practice, it should be coded to prevent empty input. Since I am only a untrained amateur, and if I was your boss and I saw this bad script you would be looking for a new job quickly.
-
If they cancel then it should just close every thing. What you are trying to do is illogical. Think about it get user input give option there to cancel, after submit run the whole script period. I coded it so it open the doc, then after the user closes the doc you can update it with the change information. That the most simple way of doing it. Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Obj For Each Obj In Fso.GetFolder(".").Files If LCase(Right(Obj.Name,3)) = "doc" And _ InStr(1,Obj.Path,"offerte",1) Then WScript.Echo Obj.Name End If Next Results on my desktop Some Test offerte.doc
-
Have you ever thought of just adding the vbs script to the hta. Example Function ProcessFinished() '-> Open User Input Doc Act.Run(Chr(34) & UserDoc & Chr(34)),1,False window.clearTimeout(Tm1) window.close() End Function Function ProcessFinished() '-> Open User Input Doc Act.Run(Chr(34) & UserDoc & Chr(34)),1,True '-> Code To Do Whatever DOC window.clearTimeout(Tm1) window.close() End Function
-
Your code only adds the User Input F.Copy P & "\" & In2.value & "_offerte.doc" Where as I replace the offerte with the User Input UserDoc = P & "\" & Replace(F1a,Left(F1a,7),In2.value) Here is how I open the rename doc, the name and path can have as many spaces in it name and it will open. '-> Open User Input Doc Act.Run(Chr(34) & UserDoc & Chr(34)),1,False Good job at finishing the HTA your self
-
1:\ offerte.doc does this become User Input.doc, and it gets copy to User Letter \User Input Folder Name along with the VBS script. 2:\ Open The User Name.doc from User Letter \User Input Folder Name Here is the updated HTA, with changes to the copy, both files end up in the User Name folder and the doc file is rename to the user input. <!--February-06-13 Hta And Script By Gunsmokingman Aka Jake1Eye This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use. This is only posted as example code and meant only to used as such.--><TITLE>UserInput MkDir2</TITLE><HTA:APPLICATION ID="InMkDir2"SCROLL="No"SCROLLFLAT ="No"SingleInstance="Yes"ShowInTaskbar="No"SysMenu="No"MaximizeButton="No"MinimizeButton="No"Border="Thin"BORDERSTYLE ="complex"INNERBORDER ="No"Caption="Yes"WindowState="Normal"APPLICATIONNAME="InMkDir2"Icon="%SystemRoot%\explorer.exe"><STYLE type="text/css">Body{Font-Size:9.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;BackGround-Color:#EFE9E3;Text-Align:Center;Vertical-Align:Top;}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}.Tbx{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}BUTTON{Height:15pt;width:60pt;Cursor:Hand;Font:8.05pt;Font-weight:bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:#404040;Text-Align:Center;Vertical-Align:Middle;filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#E5E5E5',EndColorStr='#7D7D7D');Margin:1;Margin-Top:15pt;Padding:2;Border-Left: 1px Transparent;Border-Right: 2px Transparent;Border-Top: 1px Transparent;Border-Bottom: 2px Transparent;}</STYLE><script LANGUAGE='VBScript'>'-> Resize And Place In Approx Center Of ScreenDim Wth, Hht :Wth = int(475) :Hht = int(225)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))'-> Run Time ObjectsDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> RunTime VariblesDim F1, F2, F1a, F2a, Msg1, Tm1, UserDocMsg1=". The Textboxes Have Been Disable, Contact The " & _"System Admin To Get The Missing Files"F1a="offerte.doc"F2a="factuur.vbs"Function Window_OnLoad()'-> Check To Make Both Files ExistsCheckFile(F1a)CheckFile(F2a)If F1 = True And F2 = True ThenTx1.style.visibility = ""Tx1.style.color="#117711"Tx1.innerHTML = "Confirm " & F1a & " Confirm " & F2aElseIf F1 = True And F2 = False ThenDisableTextBoxes()Tx1.innerHTML = "Confirm " & F1a & " Missing " & F2a & Msg1ElseIf F1 = False And F2 = True ThenDisableTextBoxes()Tx1.innerHTML = "Missing " & F1a & " Confirm " & F2a & Msg1ElseIf F1 = False And F2 = False ThenDisableTextBoxes()Tx1.innerHTML = "Missing " & F1a & " Missing " & F2a & Msg1End IfEnd Function'-> Checks For FilesFunction CheckFile(F)If Fso.FileExists(F) And F=F1a Then F1 = TrueIf Fso.FileExists(F) And F=F2a Then F2 = TrueEnd Function'-> If Any File Is Missing Disable The TextBoxFunction DisableTextBoxes()Tx1.style.visibility = ""Tx1.style.Bottom = 35Tx1.style.Left = 40Tx1.style.width = 375Tx1.Align="Left"Tx1.style.color="#980000"In1.disabled = TrueIn2.disabled = TrueEnd Function'-> Process The Submit ButtonFunction MySubmit()Tx1.style.color="#980000"If Len(In1.value) = 1 And Len(In2.value) >= 3 ThenTx1.style.color="#117711" :Tx1.style.Bottom = 35Tx1.innerHTML = "Confirm, Processing Information<BR>" & _UCase(In1.value) & " " & In2.valueDisplay()ElseIf Len(In1.value) = 0 And Len(In2.value) = 0 ThenTx1.innerHTML = "Error, Fill In Both Textboxes"ElseIf Len(In1.value) = 1 And Len(In2.value) = 0 ThenTx1.innerHTML = "Error, Fill In Full Name"ElseIf Len(In1.value) = 1 And Len(In2.value) <= 3 ThenTx1.innerHTML = "Error, Full Name Less Then 3 Characters"ElseIf Len(In1.value) = 0 And Len(In2.value) >= 3 ThenTx1.innerHTML = "Error, Single Letter Missing"End IfEnd Function'-> Process The InformationFunction ProcessMySubmit()If Fso.DriveExists("H:\") Then'-> Make First FolderDim P [img=http://www.msfn.org/board/public/style_emoticons/default/tongue.gif]="H:\" & UCase(In1.value)If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)'-> Make Second FolderP = P & "\" & In2.valueIf Not Fso.FolderExists(P) Then Fso.CreateFolder(P)'-> Copy Rename offerte.doc And Get The Path And New NameSet F=Fso.GetFile(F1a)UserDoc = P & "\" & Replace(F1a,Left(F1a,7),In2.value)F.Copy P & "\" & Replace(F1a,Left(F1a,7),In2.value),True'-> Copy factuur.vbsSet F=Fso.GetFile(F2a)F.Copy P & "\" & F.Name,TrueEnd IfMsgDisplay()End Function'-> Time Dealy Then CloseFunction Display()Tm1=window.setTimeout("Process1()",2000,"VBScript")End FunctionFunction Process1()window.clearTimeout(Tm1)ProcessMySubmit()End Function'-> Time Dealy Then CloseFunction MsgDisplay()Tx1.style.color="#3377AD"Tx1.style.Bottom = 39Tx1.style.Left = 30Tx1.style.width = 395Tx1.innerHTML = "Process Completed, Preparing To Open : " & In2.value & ".doc"Tm1=window.setTimeout("ProcessFinished()",3000,"VBScript")End FunctionFunction ProcessFinished()'-> Open User Input DocAct.Run(Chr(34) & UserDoc & Chr(34)),1,Falsewindow.clearTimeout(Tm1)window.close()End Function</SCRIPT><BODY><!-- Folder Letter --><TABLE Border='1'><TD Style='Width:385;Text-Align:Left;'>Please Type In A Single Letter From A-Z</TD><TD Style=''><INPUT Type='TextBox' ID='In1' Class='Tbx' Size='1' MAXLENGTH='1'></TD></TABLE><!-- User Name --><TABLE Border='1'><TD Style='Width:325;Text-Align:Left;'>Type In Your Full Name</TD><TD Style=''><INPUT Type='TextBox' ID='In2' Class='Tbx' Size='35' MAXLENGTH='128'></TD></TABLE><BUTTON ID='Bn1' OnClick='MySubmit()'>Submit</BUTTON><BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON><!-- For Positioning The Tx1 Div Small And Large Text<DIV Style='Width:275;'>Confirm offerte1.doc Confirm factuur.vbs.</DIV><DIV Style='Width:375;Margin-Top:22pt;Text-Align:Left;'>Missing offerte1.doc Confirm factuur.vbs. TheTextboxes Have Been Disable, Contact The System Admin ToGet The Missing Files</DIV>--><DIV ID='Tx1' Style='visibility:hidden;Position:Absolute;Bottom:49;Left:90;Width:275;'></DIV></BODY>
-
What I use to make sure none of the textboxes have value, plus an additional check on the Invoice Number, for a length of 5 digits. ElseIf Len(In1.value) >= 1 And Len(In2.value) >= 1 And Len(In3.value) >= 1 Then If Len(In2.value) = 5 Then Nice try at coding, but you can use And or Or in If statements Have you tried the updated HTA
-
I made some changes to the HTA <!--February-06-13 Hta And Script By Gunsmokingman Aka Jake1Eye This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use. This is only posted as example code and meant only to used as such.--><TITLE>Demo User Input2</TITLE><HTA:APPLICATION ID="UserIn2"SCROLL="No"SCROLLFLAT ="No"SingleInstance="Yes"ShowInTaskbar="No"SysMenu="No"MaximizeButton="No"MinimizeButton="No"Border="Thin"BORDERSTYLE ="complex"INNERBORDER ="No"Caption="Yes"WindowState="Normal"APPLICATIONNAME="DmUserIn2"Icon="%SystemRoot%\explorer.exe"><STYLE type="text/css">Body{Font-Size:9.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;BackGround-Color:#EFE9E3;Text-Align:Center;Vertical-Align:Top;}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}.Tbx{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}BUTTON{Height:15pt;width:60pt;Cursor:Hand;Font:8.05pt;Font-weight:bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:#404040;Text-Align:Center;Vertical-Align:Middle;filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#E5E5E5',EndColorStr='#7D7D7D');Margin:1;Margin-Top:15pt;Padding:2;Border-Left: 1px Transparent;Border-Right: 2px Transparent;Border-Top: 1px Transparent;Border-Bottom: 2px Transparent;}</STYLE><script LANGUAGE='VBScript'>'-> Resize And Place In Approx Center Of ScreenDim Wth, Hht :Wth = int(475) :Hht = int(255)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))Dim Tm1'-> Function To Process The Submit ButtonFunction MySubmit()If Len(In1.value) = 0 And Len(In2.value) = 0 And Len(In3.value) = 0 Thenalert("No Textboxes Have Any Information")ElseIf Len(In1.value) >= 1 And Len(In2.value) = 0 And Len(In3.value) = 0 Thenalert("Only TextBox 1 Information : " & In1.value & vbCrlf & _"Please Fill In Textboxes 2 And 3 Then Press Submit")ElseIf Len(In1.value) >= 1 And Len(In2.value) >= 1 And Len(In3.value) = 0 Thenalert("TextBox 1 Information : " & In1.value & vbCrlf & _"TextBox 2 Information : " & In2.value & vbCrlf & _"Please Fill In Textboxes 3 Then Press Submit")ElseIf Len(In1.value) >= 1 And Len(In2.value) >= 1 And Len(In3.value) >= 1 ThenIf Len(In2.value) = 5 ThenMenu.style.visibility = ""In1a.value=In1.valueIn2a.value=In2.valueIn3a.value=In3.valueElsealert("Error Needs The Last Five Digits From Invoice Number : " & In2.value)End IfEnd IfEnd Function'-> Process Varibles And Display MessageFunction ProcessInfo()Tx1.style.visibility = ""Tx1.innerHTML="Processing, " & In1.value & ", " & _In2.value & ", " & In3.valueTm1 = window.setTimeout("Part1Finish()",5000,"VBScript")End Function'-> Part 1 FinishedFunction Part1Finish()window.clearTimeout(Tm1)Part2Finish()End Function'-> Process Ant End RequestFunction Part2Finish()Tx1.style.color="#3377AD"Tx1.innerHTML = "Process Completed, Preparing To Close"Tm1=window.setTimeout("Finished()",3000,"VBScript")End Function'-> Clear Timer Close HtaFunction Finished()window.clearTimeout(Tm1)window.close()End Function</SCRIPT><BODY><!-- Customer Name Area --><TABLE><TD Style='width:101;'>Customer Name</TD><TD><INPUT Type='TextBox' ID='In1' Class='Tbx' Size='40' MAXLENGTH='128'><TD></TABLE><!-- Two Textboxes Start --><TABLE><!-- Invoice Number Area --><TD Style='width:100;'>Invoice Number</TD><TD><INPUT Type='TextBox' ID='In2' Class='Tbx' Size='5' MAXLENGTH='5'Style='Margin-Right:15;' Title="Use Only The Last Five DigitsOf The Invoice Number"></TD><!-- Type Of Job Area --><TD Style='width:89;'>Type Of Job</TD><TD><INPUT Type='TextBox' ID='In3' Class='Tbx' Size='13' MAXLENGTH='16'><TD></TABLE><!-- Buttons Start --><BUTTON ID='Bn1' OnClick='MySubmit()'>Submit</BUTTON><BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON><!-- Text Display For Script Messages --><DIV ID='Tx1' Style="visibility:hidden;Width:100%;Text-Align:Center;"></DIV><!-- Pop Up Dialog --><DIV ID='Menu' Style="visibility:hidden;Position:Absolute;Top:9;Left:9;Width:425;Height:195;Text-Align:Left;Padding:3pt;Border-Left: 1px Solid; Border-Right: 2px Solid;Border-Top: 1px Solid; Border-Bottom: 2px Solid;filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#EFEAE4',EndColorStr='#9E9E9E'); "><!-- Textboxes Customer Name To Edit --><TABLE><TD Style='width:101;'>Customer Name</TD><TD><INPUT Type='TextBox' ID='In1a' Class='Tbx' Size='40' MAXLENGTH='128'></TD></TABLE><!-- Textboxes Invoice Number To Edit --><TABLE><TD Style='width:101;'>Invoice Number</TD><TD><INPUT Type='TextBox' ID='In2a' Class='Tbx' Size='5' MAXLENGTH='128'></TD></TABLE><!-- Textboxes Type Of Job To Edit --><TABLE><TD Style='width:101;'>Type Of Job</TD><TD><INPUT Type='TextBox' ID='In3a' Class='Tbx' Size='13' MAXLENGTH='16'></TD></TABLE><!-- Text Option For Dialog --><TABLE Style='Width:100%;'><TD Style='Text-Align:Left;Padding:3;'> » Please Check To Make Sure All Information Is Correct,If Not You Can Edit Out The Wrong Information With The Correct Information.Press Either The Continue Button Or Use The Cancel To Close This App.</TD></TABLE><!-- Button To Control Dialog --><TABLE Style='Width:100%;'><TD Style='Text-Align:Center;'><BUTTON OnClick="In1.value='' :In2.value='' :In3.value='' :A=1In1.value=In1a.value :In2.value=In2a.value :In3.value=In3a.valueMenu.style.visibility = 'hidden' :ProcessInfo()">Continue</BUTTON><BUTTON OnClick='window.close()'>Cancel</BUTTON></TD></TABLE></DIV></BODY>
-
I have made a HTA for you to try it uses VBS scripting to do the work <!--February-06-13 Hta And Script By Gunsmokingman Aka Jake1Eye This code is property of Gunsmokingman and Or Jake1Eye and you must have his permission to use. This is only posted as example code and meant only to used as such.--><TITLE>UserInput MkDir</TITLE><HTA:APPLICATION ID="InMkDir"SCROLL="No"SCROLLFLAT ="No"SingleInstance="Yes"ShowInTaskbar="No"SysMenu="No"MaximizeButton="No"MinimizeButton="No"Border="Thin"BORDERSTYLE ="complex"INNERBORDER ="No"Caption="Yes"WindowState="Normal"APPLICATIONNAME="InMkDir"Icon="%SystemRoot%\explorer.exe"><STYLE type="text/css">Body{Font-Size:9.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;BackGround-Color:#EFE9E3;Text-Align:Center;Vertical-Align:Top;}TD{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}.Tbx{Font-Size:8.25pt;Font-Weight:Bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:Black;}BUTTON{Height:15pt;width:60pt;Cursor:Hand;Font:8.05pt;Font-weight:bold;Font-Family:Segoe Ui, Arial,Tahoma,Comic Sans MS;Color:#404040;Text-Align:Center;Vertical-Align:Middle;filter:progid:DXImageTransform.Microsoft.Gradient(StartColorStr='#E5E5E5',EndColorStr='#7D7D7D');Margin:1;Margin-Top:15pt;Padding:2;Border-Left: 1px Transparent;Border-Right: 2px Transparent;Border-Top: 1px Transparent;Border-Bottom: 2px Transparent;}</STYLE><script LANGUAGE='VBScript'>'-> Resize And Place In Approx Center Of ScreenDim Wth, Hht :Wth = int(475) :Hht = int(225)window.ResizeTo Wth, HhtMoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))'-> Run Time ObjectsDim Act :Set Act = CreateObject("Wscript.Shell")Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")'-> RunTime VariblesDim F1, F2, F1a, F2a, Msg1, Tm1, Tm2Msg1=". The Textboxes Have Been Disable, Contact The " & _"System Admin To Get The Missing Files"F1a="offerte.doc"F2a="factuur.vbs"Function Window_OnLoad()'-> Check To Make Both Files ExistsCheckFile(F1a)CheckFile(F2a)If F1 = True And F2 = True ThenTx1.style.visibility = ""Tx1.style.color="#117711"Tx1.innerHTML = "Confirm " & F1a & " Confirm " & F2aElseIf F1 = True And F2 = False ThenDisableTextBoxes()Tx1.innerHTML = "Confirm " & F1a & " Missing " & F2a & Msg1ElseIf F1 = False And F2 = True ThenDisableTextBoxes()Tx1.innerHTML = "Missing " & F1a & " Confirm " & F2a & Msg1ElseIf F1 = False And F2 = False ThenDisableTextBoxes()Tx1.innerHTML = "Missing " & F1a & " Missing " & F2a & Msg1End IfEnd Function'-> Checks For FilesFunction CheckFile(F)If Fso.FileExists(F) And F=F1a Then F1 = TrueIf Fso.FileExists(F) And F=F2a Then F2 = TrueEnd Function'-> If Any File Is Missing Disable The TextBoxFunction DisableTextBoxes()Tx1.style.visibility = ""Tx1.style.Bottom = 35Tx1.style.Left = 40Tx1.style.width = 375Tx1.Align="Left"Tx1.style.color="#980000"In1.disabled = TrueIn2.disabled = TrueEnd Function'-> Process The Submit ButtonFunction MySubmit()Tx1.style.color="#980000"If Len(In1.value) = 1 And Len(In2.value) >= 3 ThenTx1.style.color="#117711" :Tx1.style.Bottom = 35Tx1.innerHTML = "Confirm, Processing Information<BR>" & _UCase(In1.value) & " " & In2.valueDisplay()ElseIf Len(In1.value) = 0 And Len(In2.value) = 0 ThenTx1.innerHTML = "Error, Fill In Both Textboxes"ElseIf Len(In1.value) = 1 And Len(In2.value) = 0 ThenTx1.innerHTML = "Error, Fill In Full Name"ElseIf Len(In1.value) = 1 And Len(In2.value) <= 3 ThenTx1.innerHTML = "Error, Full Name Less Then 3 Characters"ElseIf Len(In1.value) = 0 And Len(In2.value) >= 3 ThenTx1.innerHTML = "Error, Single Letter Missing"End IfEnd Function'-> Process The InformationFunction ProcessMySubmit()If Fso.DriveExists("H:\") Then'-> Make First Folder Then Copy offerte.docDim P [img=http://www.msfn.org/board/public/style_emoticons/default/tongue.gif]="H:\" & UCase(In1.value)If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)Set F=Fso.GetFile(F1a)F.Copy P & "\" & F.Name,True'-> Make Second Folder Then Copy factuur.vbsP = P & "\" & In2.valueIf Not Fso.FolderExists(P) Then Fso.CreateFolder(P)Set F=Fso.GetFile(F2a)F.Copy P & "\" & F.Name,TrueEnd IfMsgDisplay()End Function'-> Time Dealy Then CloseFunction Display()Tm1=window.setTimeout("Process1()",5000,"VBScript")End FunctionFunction Process1()window.clearTimeout(Tm1)ProcessMySubmit()End Function'-> Time Dealy Then CloseFunction MsgDisplay()Tx1.style.color="#3377AD"Tx1.style.Bottom = 39Tx1.innerHTML = "Process Completed"Tm2=window.setTimeout("ProcessFinished()",5000,"VBScript")End FunctionFunction ProcessFinished()window.clearTimeout(Tm2)window.close()End Function</SCRIPT><BODY><!-- Folder Letter --><TABLE Border='1'><TD Style='Width:385;Text-Align:Left;'>Please Type In A Single Letter From A-Z</TD><TD Style=''><INPUT Type='TextBox' ID='In1' Class='Tbx' Size='1' MAXLENGTH='1'></TD></TABLE><!-- User Name --><TABLE Border='1'><TD Style='Width:325;Text-Align:Left;'>Type In Your Full Name</TD><TD Style=''><INPUT Type='TextBox' ID='In2' Class='Tbx' Size='35' MAXLENGTH='128'></TD></TABLE><BUTTON ID='Bn1' OnClick='MySubmit()'>Submit</BUTTON><BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON><!-- For Positioning The Tx1 Div Small And Large Text<DIV Style='Width:275;'>Confirm offerte1.doc Confirm factuur.vbs.</DIV><DIV Style='Width:375;Margin-Top:22pt;Text-Align:Left;'>Missing offerte1.doc Confirm factuur.vbs. TheTextboxes Have Been Disable, Contact The System Admin ToGet The Missing Files</DIV>--><DIV ID='Tx1' Style='visibility:hidden;Position:Absolute;Bottom:49;Left:90;Width:275;'></DIV></BODY>
-
Code Update when all three textboxes are filled in, then it ask yes to go on,no and redo, cancel to close If Len(In2.value) = 5 Then Dim A :A=MsgBox("Is All The Information Correct" & vbCrlf & _ "TextBox 1 Information : " & In1.value & vbCrlf & _ "TextBox 2 Information : " & In2.value & vbCrlf & _ "TextBox 3 Information : " & In3.value & vbCrlf & vbCrlf & _ "Ok To Continue" & vbCrlf & "No Redo The Information" & vbCrlf & _ "Cancel To Close And Exit",4131) If A = 6 Then alert("Script Place Holder For Yes Actions") ElseIf A = 7 Then In1.value="" :In2.value="" :In3.value="" : ElseIf A = 2 Then window.close() End If Else alert("Error Needs The Last Five Digits From Invoice Number : " & In2.value) End If
-
Nice Flow Chart, but to many yes/no/cancel for my liking 1:\ Collect all information needed 2a:\ Confirm information 2b:\ redo if wrong, 2c:\ then offer to exit and do nothing 3:\ Process information to the various varibles 4:\ Check for folder, 5:\ Process all information 6:\ Finish dialog if needed