[gunsmokingman]

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 

[oxb]

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

This post has been edited by oxb: 09 February 2013 - 02:25 PM

[gunsmokingman]

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

[oxb]

gunsmokingman, on 09 February 2013 - 02:49 PM, said:

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

This post has been edited by oxb: 09 February 2013 - 03:05 PM

[gunsmokingman]

Quote

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

[oxb]

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)

This post has been edited by oxb: 09 February 2013 - 04:28 PM

[gunsmokingman]

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.

[oxb]

gunsmokingman, on 09 February 2013 - 05:20 PM, said:

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

[gunsmokingman]

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.

[oxb]

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

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 :P= (myCur & "\2013\") & LCase(In1.value) 

This post has been edited by oxb: 10 February 2013 - 06:03 AM

[gunsmokingman]

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

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

[oxb]

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!
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.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)).

This post has been edited by oxb: 10 February 2013 - 01:55 PM

[gunsmokingman]

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
-->
 <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 :P="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>

End results of HTA
 Hta_Results.png (224.53K)
Number of downloads: 11

 UserInput_MkDir3.zip (2.6K)
Number of downloads: 3

[oxb]

Showoff

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

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

This post has been edited by oxb: 10 February 2013 - 03:18 PM

[gunsmokingman]

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.

[oxb]

gunsmokingman, on 10 February 2013 - 03:18 PM, said:

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?

[oxb]

Anyway gotta go sleep now early rise tomorrow.
Thanx for the input!

[oxb]

Hi Gunsmokingman

After 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.

[gunsmokingman]

oxb, on 20 February 2013 - 12:49 PM, said:

Hi Gunsmokingman

After 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.