Jump to content

Noob needs help vbs script change text in word .doc


Recommended Posts

Hmmkay

I 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.doc

Further 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 now


currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
input = Inputbox("Geef naam, bijv: De Groot >Zonder _offerte.doc!")
dim fso
Set FSO = CreateObject("Scripting.FileSystemObject")
Fso.Copyfile input & "_offerte.doc" , input & "_factuur.doc"
Const wdReplaceAll = 2
Set oWord = CreateObject("Word.Application")
oWord.Visible = False
set 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 ,,,,,,,,,,wdReplaceAll

End With
oDoc.Save
oDoc.Close
set oDoc = oWord.Documents.Open (currentdirectory & input & "_factuur.doc")
oWord.Visible = true

Set objFSO = CreateObject("Scripting.FileSystemObject")



strScript = Wscript.ScriptFullName
objFSO.DeleteFile(strScript)

Edited by oxb
Link to comment
Share on other sites


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.

Link to comment
Share on other sites

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.

I tried that and nothing happens?

So no probs there.

Greetz

Link to comment
Share on other sites


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.

Link to comment
Share on other sites

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 then

But your`s is better because it echo`s

bear in mind that i`m taking babysteps :yes:

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 by oxb
Link to comment
Share on other sites

Got the script to run without any userinput at all.

It now finds the ?????.doc copies it to the found name _factuur.doc

There wil only be one file in each dir using _offerte.doc so it will never take the wrong file.

deletes itself and presto! :thumbup

Automation rocks!

I like this stuff but it takes good practice and a lot of google and help from my new found friend Gunsmokingman :lol:


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.name
sText = Left(sText, Len(sText) - 12)

Set FSO = CreateObject("Scripting.FileSystemObject")

fso.copyfile Obj.name , sText & "_factuur.doc"


End If
Next



Const wdReplaceAll = 2
Set oWord = CreateObject("Word.Application")
oWord.Visible = True
set 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 ,,,,,,,,,,wdReplaceAll

End With
oDoc.Save

Set objFSO = CreateObject("Scripting.FileSystemObject")



strScript = Wscript.ScriptFullName
objFSO.DeleteFile(strScript)

PS i edited the Hta accordingly (If Fso.driveExists (myCur)).

:hello:

Edited by oxb
Link to comment
Share on other sites

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>
Link to comment
Share on other sites

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.

i know and its very nice but read above it trows an error cant wait to finish?

Link to comment
Share on other sites

  • 2 weeks later...

Hi Gunsmokingman

After implementing youre code to the server and using it for a while, i am pleased to say that its working perfectly :thumbup

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.

:hello:

Link to comment
Share on other sites

Hi Gunsmokingman

After implementing youre code to the server and using it for a while, i am pleased to say that its working perfectly :thumbup

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.

:hello:

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

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 account

Sign in

Already have an account? Sign in here.

Sign In Now
  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...