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
-->
<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 :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
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>
Frontpage
Forums
Tutorials
Members
Calendar
Subscription
Donate
Links
Contact 
Help
Back to top
) programmers have this quirk for selling you trifling things as if they were the only geniuses on earth capable of doing that 
.
