oxb Posted February 9, 2013 Author Share Posted February 9, 2013 (edited) HmmkayI think i`ll better stick to my first script where the user inputs the name of the file to be altered.This way i get my userinput_offerte.doc and userinput_factuur.docFurther all is working perfect im very glad you helped me get there.Just wanted to take away the user input.Thanks again.Using this script nowcurrentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))input = Inputbox("Geef naam, bijv: De Groot >Zonder _offerte.doc!")dim fsoSet FSO = CreateObject("Scripting.FileSystemObject")Fso.Copyfile input & "_offerte.doc" , input & "_factuur.doc" Const wdReplaceAll = 2Set oWord = CreateObject("Word.Application")oWord.Visible = Falseset oDoc = oWord.Documents.Open (currentdirectory & input & "_factuur.doc") With oWord.Selection .Find.Text = "Offerte:" .Find.Replacement.Text = "factuur:" .Find.Forward = True .Find.MatchWholeWord = True .Find.Execute ,,,,,,,,,,wdReplaceAll .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 ,,,,,,,,,,wdReplaceAllEnd WithoDoc.Save oDoc.Closeset oDoc = oWord.Documents.Open (currentdirectory & input & "_factuur.doc") oWord.Visible = trueSet objFSO = CreateObject("Scripting.FileSystemObject")strScript = Wscript.ScriptFullNameobjFSO.DeleteFile(strScript) Edited February 9, 2013 by oxb Link to comment Share on other sites More sharing options...
gunsmokingman Posted February 9, 2013 Share Posted February 9, 2013 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 youwould be looking for a new job quickly. Link to comment Share on other sites More sharing options...
oxb Posted February 10, 2013 Author Share Posted February 10, 2013 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 youwould be looking for a new job quickly.I tried that and nothing happens?So no probs there.Greetz Link to comment Share on other sites More sharing options...
gunsmokingman Posted February 10, 2013 Share Posted February 10, 2013 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 notyour boss, so I dont have to worry about any problems. Link to comment Share on other sites More sharing options...
oxb Posted February 10, 2013 Author Share Posted February 10, 2013 (edited) I came up with this input = Inputbox("Geef naam, bijv: De Groot >Zonder _offerte.doc!") if IsNull(strValue) then strValue = 0 Else strValue = (strValue) end If if strvalue <> 1 thenBut your`s is better because it echo`sbear in mind that i`m taking babysteps Also i edited the .hta file so that the dir it runs from it sets the driveletter and dir to use.It runs ok, but do you see a problem with it? Set objShell = CreateObject("WScript.Shell") myCur = objShell.CurrentDirectory If Fso.driveExists (myCur) Then <NOT SURE ABOUT THIS LINE BEEING CORRECT'-> Make First Folder Then Copy offerte.doc Dim P = (myCur & "\2013\") & LCase(In1.value) Edited February 10, 2013 by oxb Link to comment Share on other sites More sharing options...
gunsmokingman Posted February 10, 2013 Share Posted February 10, 2013 Set objShell = CreateObject("WScript.Shell") myCur = objShell.CurrentDirectory If Fso.driveExists (myCur) Set objShell = CreateObject("WScript.Shell") myCur = objShell.CurrentDirectory If Fso.driveExists (myCur) Link to comment Share on other sites More sharing options...
oxb Posted February 10, 2013 Author Share Posted February 10, 2013 (edited) Got the script to run without any userinput at all.It now finds the ?????.doc copies it to the found name _factuur.docThere wil only be one file in each dir using _offerte.doc so it will never take the wrong file.deletes itself and presto! Automation rocks!I like this stuff but it takes good practice and a lot of google and help from my new found friend Gunsmokingman V\currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName))) Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")Dim Obj For Each Obj In Fso.GetFolder(".").Files If LCase(Right(Obj.Name,12)) = "_offerte.doc" Then sText = Obj.namesText = Left(sText, Len(sText) - 12) Set FSO = CreateObject("Scripting.FileSystemObject") fso.copyfile Obj.name , sText & "_factuur.doc" End If Next Const wdReplaceAll = 2Set oWord = CreateObject("Word.Application")oWord.Visible = Trueset oDoc = oWord.Documents.Open (currentdirectory & sText & "_factuur.doc") With oWord.Selection .Find.Text = "Offerte:" .Find.Replacement.Text = "factuur:" .Find.Forward = True .Find.MatchWholeWord = True .Find.Execute ,,,,,,,,,,wdReplaceAll .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 ,,,,,,,,,,wdReplaceAllEnd WithoDoc.Save Set objFSO = CreateObject("Scripting.FileSystemObject")strScript = Wscript.ScriptFullNameobjFSO.DeleteFile(strScript) PS i edited the Hta accordingly (If Fso.driveExists (myCur)). Edited February 10, 2013 by oxb Link to comment Share on other sites More sharing options...
gunsmokingman Posted February 10, 2013 Share Posted February 10, 2013 Here is a HTA that has the doc edit in it script, this still does copy Offerte.doc and factuur.vbs butyou 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> Link to comment Share on other sites More sharing options...
oxb Posted February 10, 2013 Author Share Posted February 10, 2013 (edited) Showoff Very nice, i got whipped by the master GZonna test nowGood skills ThanxGives an error Cant wait for process to finish line 169?? Edited February 10, 2013 by oxb Link to comment Share on other sites More sharing options...
gunsmokingman Posted February 10, 2013 Share Posted February 10, 2013 I was just trying to show that you did not need the VBS script to edit the doc, the HTA provides allthe information you need to all the tasks. Link to comment Share on other sites More sharing options...
oxb Posted February 10, 2013 Author Share Posted February 10, 2013 I was just trying to show that you did not need the VBS script to edit the doc, the HTA provides allthe information you need to all the tasks.i know and its very nice but read above it trows an error cant wait to finish? Link to comment Share on other sites More sharing options...
oxb Posted February 10, 2013 Author Share Posted February 10, 2013 Anyway gotta go sleep now early rise tomorrow.Thanx for the input! Link to comment Share on other sites More sharing options...
oxb Posted February 20, 2013 Author Share Posted February 20, 2013 Hi GunsmokingmanAfter implementing youre code to the server and using it for a while, i am pleased to say that its working perfectly Just wanted to say thanx again for youre help, me and my colleagues are loving it!I hope i can call on you if i ever need help again. Link to comment Share on other sites More sharing options...
gunsmokingman Posted February 20, 2013 Share Posted February 20, 2013 Hi GunsmokingmanAfter implementing youre code to the server and using it for a while, i am pleased to say that its working perfectly Just wanted to say thanx again for youre help, me and my colleagues are loving it!I hope i can call on you if i ever need help again. Thank you and if you ever need help, just post your problem, I or my fellow mods will do or best to try and help. Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now