Jump to content

Welcome to MSFN Forum
Register now to gain access to all of our features. Once registered and logged in, you will be able to create topics, post replies to existing threads, give reputation to your fellow members, get your own private messenger, post status updates, manage your profile and so much more. This message will be removed once you have signed in.
Login to Account Create an Account



Photo

Noob needs help vbs script change text in word .doc

- - - - -

  • Please log in to reply
58 replies to this topic

#51
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,419 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
   Set objShell = CreateObject("WScript.Shell")     
   myCur = objShell.CurrentDirectory    
   If Fso.driveExists (myCur)



   Set objShell = CreateObject("WScript.Shell")     
   myCur = objShell.CurrentDirectory    
   If Fso.driveExists (myCur)



GunSmokingMan




How to remove advertisement from MSFN

#52
oxb

oxb

    Newbie

  • Member
  • 29 posts
  • Joined 20-February 05
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, 10 February 2013 - 01:55 PM.


#53
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,419 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
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 Screen
Dim Wth, Hht :Wth = int(475) :Hht = int(225)
window.ResizeTo Wth, Hht
MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))
'-> Run Time Objects
Dim Act :Set Act = CreateObject("Wscript.Shell")
Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
'-> RunTime Varibles
Dim F1, F2, F1a, F2a, Msg1, Tm1, UserDoc
Msg1=". 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 Exists
CheckFile(F1a)
CheckFile(F2a)
If F1 = True And F2 = True Then
Tx1.style.visibility = ""
Tx1.style.color="#117711"
Tx1.innerHTML = "Confirm " & F1a & " Confirm " & F2a
ElseIf F1 = True And F2 = False Then
DisableTextBoxes()
Tx1.innerHTML = "Confirm " & F1a & " Missing " & F2a & Msg1
ElseIf F1 = False And F2 = True Then
DisableTextBoxes()
Tx1.innerHTML = "Missing " & F1a & " Confirm " & F2a & Msg1
ElseIf F1 = False And F2 = False Then
DisableTextBoxes()
Tx1.innerHTML = "Missing " & F1a & " Missing " & F2a & Msg1
End If
End Function
'-> Checks For Files
Function CheckFile(F)
If Fso.FileExists(F) And F=F1a Then F1 = True
If Fso.FileExists(F) And F=F2a Then F2 = True
End Function
'-> If Any File Is Missing Disable The TextBox
Function DisableTextBoxes()
Tx1.style.visibility = ""
Tx1.style.Bottom = 35
Tx1.style.Left = 40
Tx1.style.width = 375
Tx1.Align="Left"
Tx1.style.color="#980000"
In1.disabled = True
In2.disabled = True
End Function
'-> Process The Submit Button
Function MySubmit()
Tx1.style.color="#980000"
If Len(In1.value) = 1 And Len(In2.value) >= 3 Then
Tx1.style.color="#117711" :Tx1.style.Bottom = 35
Tx1.innerHTML = "Confirm, Processing Information<BR>" & _
UCase(In1.value) & " " & In2.value
Display()
ElseIf Len(In1.value) = 0 And Len(In2.value) = 0 Then
Tx1.innerHTML = "Error, Fill In Both Textboxes"
ElseIf Len(In1.value) = 1 And Len(In2.value) = 0 Then
Tx1.innerHTML = "Error, Fill In Full Name"
ElseIf Len(In1.value) = 1 And Len(In2.value) <= 3 Then
Tx1.innerHTML = "Error, Full Name Less Then 3 Characters"
ElseIf Len(In1.value) = 0 And Len(In2.value) >= 3 Then
Tx1.innerHTML = "Error, Single Letter Missing"
End If
End Function
'-> Process The Information
Function ProcessMySubmit()
If Fso.DriveExists("H:\") Then
'-> Make First Folder
Dim 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 Folder
P = P & "\" & In2.value
If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)
'-> Copy Rename offerte.doc And Get The Path And New Name
Set 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.vbs
Set F=Fso.GetFile(F2a)
F.Copy P & "\" & F.Name,True
End If
MsgDisplay()
End Function
'-> Time Dealy Then Close
Function Display()
Tm1=window.setTimeout("Process1()",2000,"VBScript")
End Function
Function Process1()
window.clearTimeout(Tm1)
ProcessMySubmit()
End Function
'-> Time Dealy Then Close
Function MsgDisplay()
Tx1.style.color="#3377AD"
Tx1.style.Bottom = 39
Tx1.style.Left = 30
Tx1.style.width = 395
'-> Open User Input Doc
Act.Run(Chr(34) & UserDoc & Chr(34)),1,True
Tx1.innerHTML = "Starting To Update : " & In2.value & ".doc"
Tm1=window.setTimeout("ProcessFinished()",3000,"VBScript")
End Function
Function ProcessFinished()
'-> Add New Text
Dim 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 ,,,,,,,,,,2
End With
oDoc.Save
oDoc.Close
oWord.Quit
window.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. The
Textboxes Have Been Disable, Contact The System Admin To
Get The Missing Files</DIV>
-->
<DIV ID='Tx1' Style='visibility:hidden;Position:Absolute;
Bottom:49;Left:90;Width:275;'></DIV>
</BODY>



GunSmokingMan



#54
oxb

oxb

    Newbie

  • Member
  • 29 posts
  • Joined 20-February 05
Showoff :lol:

Very nice, i got whipped by the master :blushing:
GZonna test now
Good skills
Thanx

Gives an error
Cant wait for process to finish line 169??

Edited by oxb, 10 February 2013 - 03:18 PM.


#55
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,419 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag
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.


GunSmokingMan



#56
oxb

oxb

    Newbie

  • Member
  • 29 posts
  • Joined 20-February 05

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?

#57
oxb

oxb

    Newbie

  • Member
  • 29 posts
  • Joined 20-February 05
Anyway gotta go sleep now early rise tomorrow.
Thanx for the input!

#58
oxb

oxb

    Newbie

  • Member
  • 29 posts
  • Joined 20-February 05
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:

#59
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,419 posts
  • Joined 02-August 03
  • OS:none specified
  • Country: Country Flag

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.


GunSmokingMan






0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users