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

#26
oxb

oxb

    Newbie

  • Member
  • 29 posts
Gunsmokingman

I tried youre script and like it very much :thumbup
However there are 2 (for you ) small things

The offerte.doc needs to be in the same folder as factuur.vbs ex folder J >john doe >factuur.vbs+offerte.doc< wich needs to be renamed to> john doe.doc
The situation now is J>offerte.doc > john doe > factuur.vbs

The offerte.doc shouldt be renamed after the user input > john doe .doc

Also couldt you please edit script that after creation of john doe.doc it gets opened in word? :unsure:

I have been playing about with youre script (tried it myself) but i seem to mess up.

Again thanx for youre effort :thumbup

EDIT
Nevermind i tried and figured out myself how to do it.
Thanx for all your hard work Gunsmokeman
Thank you jaclaz

If you ever need new carpet ill hop on a plane and install that for you :w00t:

Edited by oxb, 07 February 2013 - 02:38 PM.



How to remove advertisement from MSFN

#27
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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 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
Tx1.innerHTML = "Process Completed, Preparing To Open : " & In2.value & ".doc"
Tm1=window.setTimeout("ProcessFinished()",3000,"VBScript")
End Function
Function ProcessFinished()
'-> Open User Input Doc
Act.Run(Chr(34) & UserDoc & Chr(34)),1,False
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



#28
oxb

oxb

    Newbie

  • Member
  • 29 posts
This is what i came up with (copy paste) :lol:
Some text changed to my langauge
<!--
 February-05-13
 Hta And Script By Gunsmokingman Aka Jake1Eye
-->
 <TITLE>Maak Offerte</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 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, Tm2
  Msg1=". FOUT " & _
       "VRAAG OSCAR HULP"
  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 = "Bevestigd, Bezig met Offerte<BR>" & _
                     " " & In2.value 
    Display()                  
   ElseIf Len(In1.value) = 0 And Len(In2.value) = 0 Then    
    Tx1.innerHTML = "Fout,Voer beide velden in!"
   ElseIf Len(In1.value) = 1 And Len(In2.value) = 0 Then
    Tx1.innerHTML = "Fout, Voer naam in!"
   ElseIf Len(In1.value) = 1 And Len(In2.value) <= 3 Then
    Tx1.innerHTML = "Fout, Naam minimaal 3 letters"
   ElseIf Len(In1.value) = 0 And Len(In2.value) >= 3 Then
    Tx1.innerHTML = "Fout, Voer alfabetische letter in!"
   End If
  End Function
'-> Process The Information
  Function ProcessMySubmit()
   If Fso.DriveExists("D:\") Then
'-> Make First Folder Then Copy offerte.doc
    Dim P <img src='http://www.msfn.org/board/public/style_emoticons/<#EMO_DIR#>/tongue.gif' class='bbc_emoticon' alt=':P' />="D:\" & LCase(In1.value) 
    If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)
'-> Make Second Folder Then Copy factuur.vbs
     P = P & "\" & In2.value
    If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)
    Set F=Fso.GetFile(F2a)
     F.Copy P & "\" & F.Name,True 
	Set F=Fso.Getfile(F1a)
	F.Copy P & "\" & In2.value & "_offerte.doc"
 Set oWord = CreateObject("Word.Application")   
   set oDoc = oWord.Documents.Open (P & "\" & In2.value & "_offerte.doc")
   oWord.Visible = true	
      End If
   MsgDisplay()
  End Function  
'-> Time Dealy Then Close
  Function Display()
   Tm1=window.setTimeout("Process1()",5000,"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.innerHTML = "Offerte Klaar"
   Tm2=window.setTimeout("ProcessFinished()",2000,"VBScript")
    
  End Function
  Function ProcessFinished()
    window.clearTimeout(Tm2)
    window.close()
  End Function
</SCRIPT>
<BODY>
<!-- Folder Letter -->
 <TABLE Border='1'><TD Style='Width:385;Text-Align:Left;'>
Voer alfabetische letter in</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;'>
  Naam klant</TD><TD Style=''>
  <INPUT Type='TextBox' ID='In2' Class='Tbx' Size='35' MAXLENGTH='128'>
  </TD></TABLE>
 <BUTTON ID='Bn1' OnClick='MySubmit()'>Start</BUTTON>
 <BUTTON ID='Bn2' OnClick='window.close()'>Sluiten</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 added code tags

#29
submix8c

submix8c

    Inconceivable!

  • Patrons
  • 4,281 posts
  • OS:none specified
  • Country: Country Flag
@oxb - when you want to post "code" use
some code here
to keep from disturbing the code. Note that you now have an "emoticon" (smiley face) in your code. The way to do above "code" is
[ code ]something[ /endcode ]
(remove the blanks inside brackets). ;)

edit - DOH!!! Was too quick with that (see jaclaz' below). Edited (remove strikethrough from it)...
Aaand - OK, just got too used to manually doing
"stuff"
(senselessly of course, seeing as how that little icon works...)

Edited by submix8c, 08 February 2013 - 12:36 PM.

Someday the tyrants will be unthroned... Jason "Jay" Chasteen; RIP, bro!

Posted Image


#30
jaclaz

jaclaz

    The Finder

  • Developer
  • 14,390 posts
  • OS:none specified
  • Country: Country Flag

The way to do above "code" is [ code ]something[ /endcode ] (remove the blanks inside brackets). ;)

Not really. :no:
It is [ code] and [ /code] (not [ /endcode]), and in practice you select what you want to insert in CODE tags, then click on the little icon senselessy representing "<>" which you find in "post" or "edit" mode.

jaclaz

Edited by jaclaz, 08 February 2013 - 12:06 PM.


#31
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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


GunSmokingMan



#32
oxb

oxb

    Newbie

  • Member
  • 29 posts

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


Thanks for all the effort,
And thanks for the good job statement that means a lot coming from you.

Thanks to the others for the input i got a little wizer in scripting.

The thing is sometimes i want something automated and then i go all-in.
But it takes a long time before i have a new project, and by then i forgot most part of it.

If you see the amount of code used to do something this simple you get some more respect for coders and programmers.
We are all accustomed that the pc works when we turn it on, but really never stand stil by whats behind it all.

So respect to all of you :thumbup

Maybe we meet again on this forum if i got something else to play around with.

Edited by oxb, 08 February 2013 - 01:49 PM.


#33
jaclaz

jaclaz

    The Finder

  • Developer
  • 14,390 posts
  • OS:none specified
  • Country: Country Flag

If you see the amount of code used to do something this simple you get some more respect for coders and programmers.
We are all accustomed that the pc works when we turn it on, but really never stand stil by whats behind it all.


That is the initial steep of the curve, after you will get the hang of it you will probably start wondering how come that some (not necessarily all :)) programmers have this quirk for selling you trifling things as if they were the only geniuses on earth capable of doing that :ph34r: .

Seriously, I have seen guys putting together half @§§ed MS Access "custom databases" (actually no more that a few forms and reports) talking as if they were Linus Torvalds or Sergey Brin :w00t:

jaclaz

#34
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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.


GunSmokingMan



#35
oxb

oxb

    Newbie

  • Member
  • 29 posts


If you see the amount of code used to do something this simple you get some more respect for coders and programmers.
We are all accustomed that the pc works when we turn it on, but really never stand stil by whats behind it all.


That is the initial steep of the curve, after you will get the hang of it you will probably start wondering how come that some (not necessarily all :)) programmers have this quirk for selling you trifling things as if they were the only geniuses on earth capable of doing that :ph34r: .

Seriously, I have seen guys putting together half @§§ed MS Access "custom databases" (actually no more that a few forms and reports) talking as if they were Linus Torvalds or Sergey Brin :w00t:

jaclaz


LoL Yeah i know what you mean, i am quite good as to setting up a network enviroment as a hobby.
Sometimes i have some it guy come over and i have to make corrections to his s***.
My brother in law wanted a vpn connection to his office, the reply was: not possible! you need new computers
i spend some time on it and got it to work.
Just tried to rip him off :realmad:

:hello:
I

#36
jaclaz

jaclaz

    The Finder

  • Developer
  • 14,390 posts
  • OS:none specified
  • Country: Country Flag

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.

Sure, reading is easy :).
Writing is another thing.

However you would be surprised by the little thingies that this old dinosaur wrote in VBA (for Excel) ;).

jaclaz

#37
oxb

oxb

    Newbie

  • Member
  • 29 posts
Damnit Got a problem

Today i tried to run the script on the NAS but i believe the path is not correct.
On the pc there is a network connection to the drive (Z:)
In the script i tried to put in the networkdriveletter Z:
The script runs and gives error not finding document, the folder is not created and there are no files copied.
Do i have to fill in something like %networkdrive% or %networkpath% in line 137/139

So dissapointed here at home everything worked fine even got the script to take user input to fill in the adress in the document.
I
Any ideas?

Thanx

EDIT
Nevermind got it fixed stupid was running the hta locally not from nas drive :blushing:

Edited by oxb, 09 February 2013 - 11:14 AM.


#38
oxb

oxb

    Newbie

  • Member
  • 29 posts
Still one more question :lol:

How can i make this script look for the .doc file and automaticly use that .doc?
This vbs wil be in the same folder as the userinput,doc
The userinput.doc name will change every time so i would like to use a wildcard like in dos *.doc but dont know how to do it in vbs.
Note that there wil be only one .doc file in the same directory as this vbs script. it wil always be named like this userinput_offerte.doc.
I wouldt like to take out the userinput just click and go.

currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
input = Inputbox("Geef naam, bijv: De Groot")
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 =True
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 


Set objFSO = CreateObject("Scripting.FileSystemObject")



strScript = Wscript.ScriptFullName
objFSO.DeleteFile(strScript)

Edited by oxb, 09 February 2013 - 11:45 AM.


#39
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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 



GunSmokingMan



#40
oxb

oxb

    Newbie

  • Member
  • 29 posts

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 


Going to try this one out thanx yet again :thumbup

#41
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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 



GunSmokingMan



#42
oxb

oxb

    Newbie

  • Member
  • 29 posts
Ok

So far so good
The file is found the script does its magic.
Now im left with another question
i need the file to be copied and saved as a new document but i need part of the name replaced.
What i am left with now is name_offerte.doc is copied over to name_offerte.docfactuur.doc<in one line

Is there a way to take the last part of the string in name_offerte.doc where i only get the name as a string minus _offerte.doc?
I read you can use replace function but i cant see to implement that
The tricky thing is the file needs to be opened at the end so if i rename it how do i open it if i dont know its name if the name is not always the same.(only the end part _offerte.doc, or _factuur.doc)

dont know if i make any sense but what i need is the file to be opened word replace takes place and file needs to be saved as name_factuur.doc

CD = 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,3)) = "doc" Then
   Set FSO = CreateObject("Scripting.FileSystemObject")
Fso.Copyfile Obj.name , Obj.name & "" & "Factuur.doc"
    	
	Set oWord = CreateObject("Word.Application")
oWord.Visible = True
set oDoc = oWord.Documents.Open (CD & Obj.name & "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 (CD & Obj.name & "factuur.doc") 
oWord.Visible = true

Set objFSO = CreateObject("Scripting.FileSystemObject")



strScript = Wscript.ScriptFullName
objFSO.DeleteFile(strScript) 
  End if
  Next

Edited by oxb, 09 February 2013 - 02:25 PM.


#43
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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



GunSmokingMan



#44
oxb

oxb

    Newbie

  • Member
  • 29 posts

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


No because it is an option to run, and it will only need to run after the offerte.doc is filled in.
There is a chance it will never be run if the order is cancelled.

Have you got any ideas how to edit the vbs so that the file is copied to name_factuur?
Greetz oscar

Edited by oxb, 09 February 2013 - 03:05 PM.


#45
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag

No because it is an option to run, and it will only need to run after the offerte.doc is filled in.
There is a chance it will never be run if the order is cancelled.



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


GunSmokingMan



#46
oxb

oxb

    Newbie

  • Member
  • 29 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, 09 February 2013 - 04:28 PM.


#47
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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.


GunSmokingMan



#48
oxb

oxb

    Newbie

  • Member
  • 29 posts

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

#49
gunsmokingman

gunsmokingman

    MSFN Master

  • Super Moderator
  • 2,418 posts
  • OS:none specified
  • Country: Country Flag
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.


GunSmokingMan



#50
oxb

oxb

    Newbie

  • Member
  • 29 posts
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 <img src='http://www.msfn.org/board/public/style_emoticons/<#EMO_DIR#>/tongue.gif' class='bbc_emoticon' alt=':P' />= (myCur & "\2013\") & LCase(In1.value)

Edited by oxb, 10 February 2013 - 06:03 AM.





0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users



How to remove advertisement from MSFN