Jump to content

gunsmokingman

Super Moderator
  • Posts

    2,296
  • Joined

  • Last visited

  • Donations

    0.00 USD 
  • Country

    Canada

Everything posted by gunsmokingman

  1. 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.
  2. 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
  3. 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.
  4. 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
  5. I was just trying to show that you did not need the VBS script to edit the doc, the HTA provides all the information you need to all the tasks.
  6. 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>
  7. Set objShell = CreateObject("WScript.Shell") myCur = objShell.CurrentDirectory If Fso.driveExists (myCur) Set objShell = CreateObject("WScript.Shell") myCur = objShell.CurrentDirectory If Fso.driveExists (myCur)
  8. 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.
  9. 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.
  10. 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
  11. 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
  12. Just a quick note for you If the doc file in the same foler use For Each Obj In Fso.GetFolder(".").Files If you want to add a path to the doc For Each Obj In Fso.GetFolder("DRIVELETTER:\FOLDERNAME\ANOTHERFOLDER").Files
  13. Here this will sort out the doc type , you will have to work out where to place it in your script. Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject") Dim Obj For Each Obj In Fso.GetFolder(".").Files If LCase(Right(Obj.Name,3)) = "doc" Then WScript.Echo Obj.Name End If Next
  14. jaclaz have you learned how to read VBS script yet. Myself I can write in mutilple langauges, cmd, html, hta, vbs, Jscript, Vb.net and you? All self taught , unless you really want to count one semester of programmming in around 1983 when I went to college.
  15. Make these changes to your script and see if that works Dim EmailTxt Do Until objFile.AtEndOfStream EmailTxt= EmailTxt & vbCrLf & objFile.ReadLine Loop objFile.Close Set objEmail.Textbody = EmailTxt
  16. 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
  17. 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>
  18. 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
  19. 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>
  20. 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>
  21. I will post a updated script with the changes later on.
  22. I only put that there so it posted here as it original writer. What you do change or I may help with you can place what you feel is needed.
  23. 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
  24. Confirmation, user makes sure all info there if not then ask user to quit or redo If all information is correct then ask yes to go on or no to quit Then process all the varibles, run them threw the script, option finish I dont like having a window open to some folder for no reason.
  25. 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
×
×
  • Create New...