MSFN Forum: Noob needs help vbs script change text in word .doc - MSFN Forum

Jump to content


  • 3 Pages +
  • 1
  • 2
  • 3
  • You cannot start a new topic
  • You cannot reply to this topic

Noob needs help vbs script change text in word .doc Rate Topic: -----

#1 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 04 February 2013 - 12:36 PM

Hi all

For my business i need a script to change certain text in a word .doc
In my own way i have made a small batch script that uses user input to make a directory and .doc filename with the name the user gave.
I have got a office.document that is copied over with the name the user gave in the folder the user specified. (this document is always the same is copied over with name user gave)

after creation the document is opened so the user can fill in the document.

After creation of the document offerte_example.doc i need the script to find the offerte_example.doc file (only .doc file in folder) take its name en copie to factuur_example.doc, (offerte_example.doc needs to stay!)
after that change some text to another part of text. (text is always the same only needs to be changed to different text)
The script itself wil be in the same folder as the example.doc file.
Hope i made myself clear what i want .
I am not a coder so please be patient.

Youre help is greatly appriciated.

Thanx in advance.


#2 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 04 February 2013 - 01:37 PM

I am lost as to what you want, do you want to copy a file and rename factuur_example.doc to factuur_offerte_example.doc
It would also help if you post any code that you are using.

#3 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 04 February 2013 - 03:04 PM

I want the offerte_example.doc copied to factuur_example.doc
Then i want to edit some standard text thats always present in offerte_example.doc wich is now filled in with the users text (wich wil stay there)
As offerte_example.doc is copied to factuur_example.doc this wil be a exact copy But a few standard lines need to be changed.
Dont know how to put it in better words.
I found a script that will change the lines of text, but as i dont know how the user will name the file i dont know how to pass the filename to the script.
The file also needs to be copied as its a file with cel en table`s dos wont do the trick.
The file below does not copy, i need copy and replace
i will post the script below

Const wdReplaceAll = 2
Set oWord = CreateObject("Word.Application")
oWord.Visible = False
set oDoc = oWord.Documents.Open("dont know what to put here")
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
oWord.Quit

This post has been edited by oxb: 04 February 2013 - 03:13 PM


#4 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 04 February 2013 - 07:07 PM

You know it would be better to use VBS script to get the user input and then pass that varible.
Example
Dim UserInput
 GetUserInput()
 
   Function GetUserInput()
    Do
     UserInput = InputBox(_
     "Text With Details About User Input Required" & vbCrLf & vbCrLf &_
     "To Close And Do Nothing, Type Exit Or Quit","","",6500,5500)
     If InStr(1,UserInput,"exit",1) And Len(UserInput) = 4 Or _
        InStr(1,UserInput,"quit",1) And Len(UserInput) = 4 Then
      WScript.Quit    
     End if      
     If Not UserInput = "" And Len(UserInput) >= 0 Then
'-> User Input
      MsgBox "User Input = " & UserInput ,4128,"Input Return"
      Exit Do         
     End if  
    Loop Until Len(Input) = 1000
   End Function



#5 User is offline   jaclaz 

  • The Finder
  • Group: Developers
  • Posts: 11,456
  • Joined: 23-July 04
  • OS:none specified
  • Country: Country Flag

Posted 05 February 2013 - 04:16 AM

Maybe relevant, maybe not, please consider how a Word document contains some metadata (including name it was last saved with - as an example) which may need to be updated.
What you posted seems not like VBS (Visual Basic Script language) but rather VBA (Visual Basic for Applications).
Have you considered leveraging on Word built-in features, such as Mail Merge?

jaclaz

#6 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 05 February 2013 - 09:35 AM

Thanx for the info, like i said big noob when it comes to coding.
Mail merge never heard of will look into that and will try the code from gunsmokingman (first see if i can understand what the code does :).
First question how do i pass the userinput in the code gunsmokingman provided to the vba script?
Again noob question.

If possible would one of you edit the code i already have so that the user input is passed to the vba? script.
Thanx again for your time and help.

This post has been edited by oxb: 05 February 2013 - 09:40 AM


#7 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 05 February 2013 - 12:12 PM

UserInput in the script is a varible that can be passed to other parts of the script.

Example
Dim UserInput
 GetUserInput()
 
   Function GetUserInput()
    Do
     UserInput = InputBox(_
     "Text With Details About User Input Required" & vbCrLf & vbCrLf &_
     "To Close And Do Nothing, Type Exit Or Quit","","",6500,5500)
     If InStr(1,UserInput,"exit",1) And Len(UserInput) = 4 Or _
        InStr(1,UserInput,"quit",1) And Len(UserInput) = 4 Then
      WScript.Quit    
     End if      
     If Not UserInput = "" And Len(UserInput) >= 0 Then
'-> User Input Passed To The Function WordDocument
      WordDocument(UserInput)
      Exit Do         
     End if  
    Loop Until Len(Input) = 1000
   End Function
   
   Function WordDocument(Name)
    Const wdReplaceAll = 2
    Set oWord = CreateObject("Word.Application")
    oWord.Visible = False
    set oDoc = oWord.Documents.Open(Name & ".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
    oWord.Quit
   End Function



The above code passes UserInput which becomes the new varibles Name in the function WordDocument

#8 User is offline   jaclaz 

  • The Finder
  • Group: Developers
  • Posts: 11,456
  • Joined: 23-July 04
  • OS:none specified
  • Country: Country Flag

Posted 05 February 2013 - 12:18 PM

Loosely mail merge is traditionally used to manage "circular letters", i.e. printing a "same" letter in several copies with addresses taken from a database.
But in it's essence is a way to insert into a document "variable fields" that are "populated" or assigned values by a lookup in a database (or spreadsheet).
This may be suitable to your scopes (or it may be not).

jaclaz

#9 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 05 February 2013 - 02:16 PM

@jaclaz
i read up about mailmerge but its not suitable for me.
Thanx for the input though.

@gunsmokingman

Thanx for the script but when i run the script i get the message File not found?
I know for sure the file is there.
I am lost now dont know how to proceed, strange the file is present, name is passed on fine but no luck.
EDIT my guess is that the line set oDoc = oWord.Documents.Open (name & ".doc") is missing the full path to the directory.
The script opens word in the background and opens the requested file but i think (correct me if i am wrong) that word needs the full path,
or does it run in the same folder where the vbs file was started?
Thanx again

This post has been edited by oxb: 05 February 2013 - 02:26 PM


#10 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 05 February 2013 - 02:28 PM

set oDoc = oWord.Documents.Open(Name & ".doc")
How are you naming it? The script was just an example I never tested it for runtime errors.

#11 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 05 February 2013 - 02:32 PM

SUCCES
As mentioned earlier the path was missing!
Thank you very much Gunsmokingman im a happy camper now.
Greetz from Holland

Ended up with this vbs file

currentDirectory = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName)))
WScript.Echo currentDirectory
input = Inputbox("Enter filename")
Const wdReplaceAll = 2
Set oWord = CreateObject("Word.Application")
oWord.Visible = false
set oDoc = oWord.Documents.Open (currentdirectory & input & ".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
oWord.Quit

#12 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 05 February 2013 - 02:51 PM

It always good practice when using VBS to include checks to prevents errors. Your script will
still run even if the Inputbox is blank, the cancel being pressed, the X being pressed, that
would caused it to error out.

Another way to get CurrentDirectory=Replace(WScript.ScriptFullName,"\"&WScript.ScriptName,"")

#13 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 06 February 2013 - 10:16 AM

View Postgunsmokingman, on 05 February 2013 - 02:51 PM, said:

It always good practice when using VBS to include checks to prevents errors. Your script will
still run even if the Inputbox is blank, the cancel being pressed, the X being pressed, that
would caused it to error out.

Another way to get CurrentDirectory=Replace(WScript.ScriptFullName,"\"&WScript.ScriptName,"")



Noted wil inplement it.

I have accoplished with youre help what i tried to do, however i got one big batch file wich does take user input create dir copy files etc.
What i would really like to do is take the commands in the batch ad make it run onder vb.
Like i said everything working fine now, only thing is that my batch could look better in vb, and couldt be less messy.
If you have some time to spare please take a look at my batch DONT LAUGH :)
Maybe you got a shorter solution to my situation.
Again it works but maybe a little messy.
Thanx again.

@echo off
cls
rem PUSHD network Path to be filled in later
Echo Geef alfabetische letter en druk op enter!
choice /C:abcdefghijklmnopqrstuvwxyz /N >NUL
if '%errorlevel%'=='1' copy offerte.doc a & copy factuur.vbs a & cd a & Set directory=a
if '%errorlevel%'=='2' copy offerte.doc b & copy factuur.vbs b & cd b & Set directory=b
if '%errorlevel%'=='3' copy offerte.doc c & copy factuur.vbs c & cd c & Set directory=c
if '%errorlevel%'=='4' copy offerte.doc d & copy factuur.vbs d & cd d & Set directory=d
if '%errorlevel%'=='5' copy offerte.doc e & copy factuur.vbs e & cd e & Set directory=e
if '%errorlevel%'=='6' copy offerte.doc f & copy factuur.vbs f & cd f & Set directory=f
if '%errorlevel%'=='7' copy offerte.doc g & copy factuur.vbs g & cd g & Set directory=g
if '%errorlevel%'=='8' copy offerte.doc h & copy factuur.vbs h & cd h & Set directory=h
if '%errorlevel%'=='9' copy offerte.doc i & copy factuur.vbs i & cd i & Set directory=i
if '%errorlevel%'=='10' copy offerte.doc j & copy factuur.vbs j & cd j & Set directory=j
if '%errorlevel%'=='11' copy offerte.doc k & copy factuur.vbs k & cd k & Set directory=k
if '%errorlevel%'=='12' copy offerte.doc l & copy factuur.vbs l & cd l & Set directory=l
if '%errorlevel%'=='13' copy offerte.doc m & copy factuur.vbs m & cd m & Set directory=m
if '%errorlevel%'=='14' copy offerte.doc n & copy factuur.vbs n & cd n & Set directory=n
if '%errorlevel%'=='15' copy offerte.doc o & copy factuur.vbs o & cd o & Set directory=o
if '%errorlevel%'=='16' copy offerte.doc p & copy factuur.vbs p & cd p & Set directory=p
if '%errorlevel%'=='17' copy offerte.doc q & copy factuur.vbs q & cd q & Set directory=q
if '%errorlevel%'=='18' copy offerte.doc r & copy factuur.vbs r & cd r & Set directory=r
if '%errorlevel%'=='19' copy offerte.doc s & copy factuur.vbs s & cd s & Set directory=s
if '%errorlevel%'=='20' copy offerte.doc t & copy factuur.vbs t & cd t & Set directory=t
if '%errorlevel%'=='21' copy offerte.doc u & copy factuur.vbs u & cd u & Set directory=u
if '%errorlevel%'=='22' copy offerte.doc v & copy factuur.vbs v & cd v & Set directory=v
if '%errorlevel%'=='23' copy offerte.doc w & copy factuur.vbs w & cd w & Set directory=w
if '%errorlevel%'=='24' copy offerte.doc x & copy factuur.vbs x & cd x & Set directory=x
if '%errorlevel%'=='25' copy offerte.doc y & copy factuur.vbs y & cd y & Set directory=y
if '%errorlevel%'=='26' copy offerte.doc z & copy factuur.vbs z & cd z & Set directory=z
set cd=%cd&
set newfolder=
set /p newfolder=Achternaam ZONDER SPATIE wat wel kan Van_Zanten dus met underscore!!!:
if {%newfolder%}=={} goto :end
mkdir %newfolder%
move factuur.vbs %newfolder%
move offerte.doc %newfolder%
cd %newfolder%
rename offerte.doc %newfolder%.doc
start %newfolder%.doc
cd..
endlocal
exit


Probably already got a smile on youre face, dont you?

Greets Oscar

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


#14 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 06 February 2013 - 11:44 AM

1:\ Please note I do not have any experience at Networks, I only have one computer
2:\ This script is to replace choice /C:abcdefghijklmnopqrstuvwxyz /N >NUL
3:\ Tested this on my local drives and it copies the 2 files

In regards to Number 1 you will have read up on how to use VBS to connect to
another computer.

'-> Run Time Objects
 Dim Act :Set Act = CreateObject("Wscript.Shell")
 Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
'-> Runtime Varibles
 Dim Drv
'-> Check To Make Both Files Exists
 If Fso.FileExists("offerte.doc") And Fso.FileExists("factuur.vbs") Then
  GetDrvLtr()
 Else
  MsgBox "Error Missing the offerte.doc or factuur.vbs."
  WScript.Quit()
 End If  
   Function GetDrvLtr()
'-> Loop To Keep Inputbox Active
    Do
'-> Get Drive Letter
     Drv = InputBox(_
     "Type In The Drive Letter You Want To Use" & vbCrLf & vbCrLf &_
     "To Close And Do Nothing, Type Exit Or Quit","","",6500,5500)
'-> Quit Or Exit Script
     If InStr(1,Drv,"exit",1) And Len(Drv) = 4 Or _
        InStr(1,Drv,"quit",1) And Len(Drv) = 4 Then
      WScript.Quit    
     End if 
     If Not IsNumeric(Drv) And Len(Drv) = 1 Then
      If Fso.DriveExists(Drv) Then
       Fso.CopyFile "offerte.doc", Drv & ":\"
       Fso.CopyFile "factuur.vbs", Drv & ":\"
      Else
       MsgBox Drv & ":\ is missing. Type in another drive letter"
       GetDrvLtr()
      End If
      Exit Do
     End If      
    Loop Until Len(Drv) = 1000
   End Function 



Rename UserInput_CopyFiles.vbs.txt to UserInput_CopyFiles.vbs
Attached File  UserInput_CopyFiles.vbs.txt (1.16K)
Number of downloads: 1

#15 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 06 February 2013 - 12:19 PM

Wow thats fast

What i forgot to say that the letters used are not driveletters but folders.
Each folder contains a offer with the name of the client (stored in a folder named after the client, taken with user iput)
So structure is
networkdrive> folder >a folder >Ajax (offerte.doc copied to folder ajax as ajax.doc)
So the user first gives in the correct folder letter a,b,c,d,..etc
Then in the chosen folder a,b,c..etc a directory wil be created (user input) and the files offerte.doc and factuur.vbs will be copied there.
Later on when the text need to be altered to a bill/invoice the user will start factuur.bat and the invoice is done.

Hope you understand my english is ok ,but dont know if offer is the right word for it.

As i said everything works so if its to much trouble dont bother, its just i think neater in vb.
only one question remains, in my dos batch the userinput cant have spaces in the filled in name like> john doe it has to be john_doe.

Thank you very much.

#16 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 06 February 2013 - 12:54 PM

Test
 Dim Act :Set Act = CreateObject("Wscript.Shell")
 Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
 
 
 Fso.CopyFile "New offerte.doc", "H:\",True 
 Act.Run(chr(34) & "New offerte.doc"& Chr(34)),False 


copies without any error
but needs Double Quotes to open, Chr(34)="

1:\So the letter are for folders
2:\ You want to copy those files to the User Input Letter Folder


Updated Script, it will make the UserInput Letter Folder On Drive H, which you
can change to suit your needs, then copies the 2 files.
'-> Run Time Objects
 Dim Act :Set Act = CreateObject("Wscript.Shell")
 Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")
'-> Runtime Varibles
 Dim F, Fld
'-> Check To Make Both Files Exists
 If Fso.FileExists("offerte.doc") And Fso.FileExists("factuur.vbs") Then
  GetFldLtr()
 Else
  MsgBox "Error Missing the offerte.doc or factuur.vbs."
  WScript.Quit()
 End If  
   Function GetFldLtr()
'-> Loop To Keep Inputbox Active
    Do
'-> Get Drive Letter
     Fld = InputBox(_
     "Type In The Drive Letter You Want To Use" & vbCrLf & vbCrLf &_
     "To Close And Do Nothing, Type Exit Or Quit","","",6500,5500)
'-> Quit Or Exit Script
     If InStr(1,Fld,"exit",1) And Len(Fld) = 4 Or _
        InStr(1,Fld,"quit",1) And Len(Fld) = 4 Then
      WScript.Quit    
     End if 
     If Not IsNumeric(Fld) And Len(Fld) = 1 Then
      If Fso.DriveExists("H:\") Then
      Dim P :P="H:\"&Fld
      If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)
       Set F=Fso.GetFile("offerte.doc")
        F.Copy P&"\"&F.Name,True 
       Set F=Fso.GetFile("factuur.vbs")
        F.Copy P&"\"&F.Name,True 
      Exit Do
      Else
       MsgBox "Error This Drive H:\ Is Missing . Contact The" & vbCrLf & _
              "To Get The Correct Drive Letter",4128,"Error No Drive"
       WScript.Quit 
      End If 
     End If      
    Loop Until Len(Fld) = 1000
   End Function



Attached File  UserInput_CopyFiles2.vbs.txt (1.39K)
Number of downloads: 2

#17 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 06 February 2013 - 03:32 PM

Cool very nice
If you couldt please add to youre code a second inputbox where the user can put in the name of the folder that shouldt be created inside the first folder chosen?
So first choose folder letter>(you aced that) > after that type in name of client >(inputbox) >save offerte.doc to the name of the client in a subfolder also named after the client?
like folder J >folder John doe>john doe.doc< wich was offerte.doc.
Factuur.vbs needs to be in the same folder no rename.

After copy> creation the userinput.doc needs to be opened.


Thank you for all youre work!
I am very happy with the script :)

This post has been edited by oxb: 06 February 2013 - 03:37 PM


#18 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 06 February 2013 - 03:51 PM

I will post a updated script with the changes later on.

#19 User is offline   oxb 

  • Newbie
  • Group: Members
  • Posts: 29
  • Joined: 20-February 05

Posted 06 February 2013 - 04:21 PM

View Postgunsmokingman, on 06 February 2013 - 03:51 PM, said:

I will post a updated script with the changes later on.


Great thanx a bunch!

Going to bed now hard days work tomorrow.
Looking forward to test the code :)

#20 User is offline   gunsmokingman 

  • MSFN Master
  • Group: Super Moderator
  • Posts: 2,352
  • Joined: 02-August 03
  • OS:none specified
  • Country: Country Flag

Posted 06 February 2013 - 10:04 PM

I have made a HTA for you to try it uses VBS scripting to do the work
<!--
 February-06-13
 Hta And Script By Gunsmokingman Aka Jake1Eye
-->
 <TITLE>UserInput MkDir</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=". 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 Then Copy offerte.doc
    Dim P :P="H:\" & UCase(In1.value) 
    If Not Fso.FolderExists(P) Then Fso.CreateFolder(P)
    Set F=Fso.GetFile(F1a)
     F.Copy P & "\" & F.Name,True 
'-> 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 
   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 = "Process Completed"
   Tm2=window.setTimeout("ProcessFinished()",5000,"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;'>
   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>



Error Message
Attached File  ErrorUserInput_MkDir.png (117.04K)
Number of downloads: 4

Demo Video Of HTA

Share this topic:


  • 3 Pages +
  • 1
  • 2
  • 3
  • You cannot start a new topic
  • You cannot reply to this topic

1 User(s) are reading this topic
0 members, 1 guests, 0 anonymous users



All trademarks mentioned on this page are the property of their respective owners
Copyright © 2001 - 2013 msfn.org
Privacy Policy