• Announcements

    • xper

      MSFN Sponsorship and AdBlockers!   07/10/2016

      Dear members, MSFN is made available via subscriptions, donations and advertising revenue. The use of ad-blocking software hurts the site. Please disable ad-blocking software or set an exception for MSFN. Alternatively, become a site sponsor and ads will be disabled automatically and by subscribing you get other sponsor benefits.
13ruce

Convert Batch file to VB or Registry for Context Menu Access

33 posts in this topic

So here's what I've got so far, and it seems to work on my local drive. I'm going to update the RtPath to a mapped network share and test it a bit further. Please have a look and tell me what kinds of horrible mistakes I've made.

<!--
February-06-13
Hta And Script By Gunsmokingman Aka Jake1Eye, then mangled by 13ruce
-->
<TITLE>Demo User Input2</TITLE>
<HTA:APPLICATION ID="UserIn2"
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="DmUserIn2"
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(255)
window.ResizeTo Wth, Hht
MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))
Dim Tm1
'-> Function To Process The Submit Button
Function MySubmit()
If Len(In1.value) >= 1 And Len(In2.value) >= 1 And Len(In3.value) >= 1 Then
If Len(In2.value) = 5 Then
Menu.style.visibility = ""
In1a.value=In1.value
In2a.value=In2.value
In3a.value=In3.value
Else
alert("Error Needs The Last Five Digits From Invoice Number : " & In2.value)
End If
Else
alert("Error: Please complete all fields:")
End If
End Function

'-> Process Varibles And Display Message
Function JobBuilder()
Dim Client, Invoice, Job
Const RtPath = "c:\temp\DirectoryTest\"
Client = In1.value
Invoice = In2.value
Job = In3.value

'->SPath = Series folder: The first three digits of the invoice number
'->followed by "00 PC. IE.: 12300 PC (with Invoice value of 12345)
SPath = RtPath & (Left(Invoice,3)) & "00 PC\"
'->Cpath = Path to client folder within series
CPath = Spath & Client & "\"
'->Jpath = Path to Specific Job
JPath = CPath & Invoice & " " & Job & "\"
'->Mpath = Path to job's materials folder
MPath = Jpath & "Materials\"
'->Fpath = Path to generic files received folder. Date to be updated by user.
FPath = MPath & "YYYY.MM.DD Files Received\"
'->Dpath = Path to Design folder
DPath = Jpath & "Design\"
'->Hpath = Path to HSD folder
HPath = Jpath & "HSD\"
'->PPath = Path to Proof folder
PPath = Jpath & "Proof\"
set oFSO = CreateObject("Scripting.FileSystemObject")

'->Check to see if series folder exists. If not, build everything.
If Not oFSO.FolderExists(SPath) Then
oFSO.CreateFolder SPath
oFSO.CreateFolder CPath
oFSO.CreateFolder JPath
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
oFSO.CreateFolder DPath
oFSO.CreateFolder HPath
oFSO.CreateFolder PPath
alert("New Series Created")
'-> Check to see if Client folder exists within Series Folder. If not, build the rest.
ElseIf Not oFSO.FolderExists(CPath) Then
oFSO.CreateFolder CPath
oFSO.CreateFolder JPath
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
oFSO.CreateFolder DPath
oFSO.CreateFolder HPath
oFSO.CreateFolder PPath
alert("Client path created")
'-> Check to see if Job folder exists. If not, build all job folders.
ElseIf Not oFSO.FolderExists(JPath) Then
oFSO.CreateFolder JPath
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
oFSO.CreateFolder DPath
oFSO.CreateFolder HPath
oFSO.CreateFolder PPath
alert("New job folder created")
'-> Check to see if a Materials folder exists. If not, build it and add a Files Received subfolder.
ElseIf Not oFSO.FolderExists(MPath) Then
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
alert("Job exists. Materials folder created.")
'-> Check to see if a Files Received folder exists. If not, build it.
ElseIf Not oFSO.FolderExists(FPath) Then
oFSO.CreateFolder FPath
alert("Job Exists. New Files Received folder created.")
Else
alert("Directory already exists: " & JPath)
End If

End Function
</SCRIPT>
<BODY>
<!-- Customer Name Area -->
<TABLE><TD Style='width:101;'>Customer Name</TD><TD>
<INPUT Type='TextBox' ID='In1' Class='Tbx' Size='40' MAXLENGTH='128'>
<TD></TABLE>
<!-- Two Textboxes Start -->
<TABLE>
<!-- Invoice Number Area -->
<TD Style='width:100;'>Invoice Number</TD>
<TD><INPUT Type='TextBox' ID='In2' Class='Tbx' Size='5' MAXLENGTH='5'
Style='Margin-Right:15;' Title="Use Only The Last Five Digits
Of The Invoice Number"></TD>
<!-- Type Of Job Area -->
<TD Style='width:89;'>Type Of Job</TD>
<TD><INPUT Type='TextBox' ID='In3' Class='Tbx' Size='13' MAXLENGTH='128'><TD>
</TABLE>
<!-- Buttons Start -->
<BUTTON ID='Bn1' OnClick='MySubmit()'>Submit</BUTTON>
<BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON>
<!-- Text Display For Script Messages -->
<DIV ID='Tx1' Style="visibility:hidden;Width:100%;Text-Align:Center;">
</DIV>
<!-- Pop Up Dialog -->
<DIV ID='Menu' Style="visibility:hidden;Position:Absolute;
Top:9;Left:9;Width:425;Height:195;Text-Align:Left;Padding:3pt;
Border-Left: 1px Solid; Border-Right: 2px Solid;
Border-Top: 1px Solid; Border-Bottom: 2px Solid;
filter:progid:DXImageTransform.Microsoft.Gradient
(StartColorStr='#EFEAE4',EndColorStr='#9E9E9E'); ">
<!-- Textboxes Customer Name To Edit -->
<TABLE><TD Style='width:101;'>Customer Name</TD><TD>
<INPUT Type='TextBox' ID='In1a' Class='Tbx' Size='40' MAXLENGTH='128'>
</TD></TABLE>
<!-- Textboxes Invoice Number To Edit -->
<TABLE><TD Style='width:101;'>Invoice Number</TD><TD>
<INPUT Type='TextBox' ID='In2a' Class='Tbx' Size='5' MAXLENGTH='128'>
</TD></TABLE>
<!-- Textboxes Type Of Job To Edit -->
<TABLE><TD Style='width:101;'>Type Of Job</TD><TD>
<INPUT Type='TextBox' ID='In3a' Class='Tbx' Size='13' MAXLENGTH='16'>
</TD></TABLE>
<!-- Text Option For Dialog -->
<TABLE Style='Width:100%;'><TD Style='Text-Align:Left;Padding:3;'>
Please verify the above information. Correct as necessary.
</TD></TABLE>
<!-- Button To Control Dialog -->
<TABLE Style='Width:100%;'><TD Style='Text-Align:Center;'>
<BUTTON OnClick="In1.value='' :In2.value='' :In3.value='' :A=1
In1.value=In1a.value :In2.value=In2a.value :In3.value=In3a.value
Menu.style.visibility = 'hidden' :JobBuilder()">Continue</BUTTON>
<BUTTON OnClick='window.close()'>Cancel</BUTTON>
</TD></TABLE>
</DIV>
</BODY>

0

Share this post


Link to post
Share on other sites

I've added a bit of code that opens Explorer to the job folder:

Const NORMAL_WINDOW = 1
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "explorer.exe", JPath, , , NORMAL_WINDOW

I've placed that just before JobBuilder's "End Function." How do I get the app to automatically close afterward?

0

Share this post


Link to post
Share on other sites

To clarify: I would like the first input window to vanish as the second window pops up, as it is no longer needed.

0

Share this post


Link to post
Share on other sites

Nevermind. I added "window.close" at the end of the bit that invokes Windows Explorer and it closes everything perfectly.

0

Share this post


Link to post
Share on other sites

Another way of opening Explorer.exe

CreateObject("Wscript.Shell").Run("explorer.exe D:\"),1,False 

Perhaps change this area


End If

End Function
</SCRIPT>

To this


End If
CreateObject("Wscript.Shell").Run("explorer.exe D:\"),1,False
window.close
End Function
</SCRIPT>

The above code will open Explorer without waiting for the Explorer to be closed,

it will then close the HTA. So you should be left with the Explorer window open.

0

Share this post


Link to post
Share on other sites

Here's what I used to terminate:

End If
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "explorer.exe", JPath, , , 1
window.close
End Function

0

Share this post


Link to post
Share on other sites

So the office folks have been enjoying the new app, so thanks again for doing the hard part for me. I would like to make an improvement, so I'm back to ask the pros.

I would like to add check boxes to the initial prompt window (see image) to allow the user to choose which subfolders are generated. These subfolders include HSD, LFC, Press, Design and Database.

P26BkVf.jpg

My current code:

<!--
2013.02.14
Hta And Script By Gunsmokingman Aka Jake1Eye, then mangled by 13ruce
-->
<TITLE>AlphaGraphics Job Builder</TITLE>
<HTA:APPLICATION ID="UserIn2"
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="DmUserIn2"
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(255)
window.ResizeTo Wth, Hht
MoveTo ((Screen.Width / 2) - (Wth / 2)),((Screen.Height / 2) - (Hht / 2))
Dim Tm1
'-> Function To Process The Submit Button
Function MySubmit()
If Len(In1.value) >= 1 And Len(In2.value) >= 1 And Len(In3.value) >= 1 Then
If Len(In2.value) = 5 Then
Menu.style.visibility = ""
In1a.value=In1.value
In2a.value=In2.value
In3a.value=In3.value
Else
alert("Error: Needs The Last Five Digits From Invoice Number : " & In2.value)
End If
Else
alert("Error: Please complete all fields:")
End If
End Function

'-> Process Varibles And Display Message
Function JobBuilder()
Dim Client, Invoice, Job
Const RtPath = "X:\01 PC WIP\"
Client = In1.value
Invoice = In2.value
Job = In3.value

'->SPath = Series folder: The first three digits of the invoice number
'->followed by "00 PC. IE.: 12300 PC (with Invoice value of 12345)
SPath = RtPath & (Left(Invoice,3)) & "00 PC\"
'->Cpath = Path to client folder within series
CPath = Spath & Client & "\"
'->Jpath = Path to Specific Job
JPath = CPath & Invoice & " " & Job & "\"
'->Mpath = Path to job's materials folder
MPath = Jpath & "Materials\"
'->Fpath = Path to generic files received folder. Date to be updated by user.
FPath = MPath & "YYYY.MM.DD Files Received\"
'->Dpath = Path to Design folder
DPath = Jpath & "Design\"
'->Hpath = Path to HSD folder
HPath = Jpath & "HSD\"
'->PPath = Path to Proof folder
PPath = Jpath & "Proof\"
set oFSO = CreateObject("Scripting.FileSystemObject")

'->Check to see if series folder exists. If not, build everything.
If Not oFSO.FolderExists(SPath) Then
oFSO.CreateFolder SPath
oFSO.CreateFolder CPath
oFSO.CreateFolder JPath
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
oFSO.CreateFolder DPath
oFSO.CreateFolder HPath
oFSO.CreateFolder PPath
alert("New Series Created")
'-> Check to see if Client folder exists within Series Folder. If not, build the rest.
ElseIf Not oFSO.FolderExists(CPath) Then
oFSO.CreateFolder CPath
oFSO.CreateFolder JPath
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
oFSO.CreateFolder DPath
oFSO.CreateFolder HPath
oFSO.CreateFolder PPath
alert("Client path created")
'-> Check to see if Job folder exists. If not, build all job folders.
ElseIf Not oFSO.FolderExists(JPath) Then
oFSO.CreateFolder JPath
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
oFSO.CreateFolder DPath
oFSO.CreateFolder HPath
oFSO.CreateFolder PPath
alert("New job folder created")
'-> Check to see if a Materials folder exists. If not, build it and add a Files Received subfolder.
ElseIf Not oFSO.FolderExists(MPath) Then
oFSO.CreateFolder MPath
oFSO.CreateFolder FPath
alert("Job exists. Materials folder created.")
'-> Check to see if a Files Received folder exists. If not, build it.
ElseIf Not oFSO.FolderExists(FPath) Then
oFSO.CreateFolder FPath
alert("Job Exists. New Files Received folder created.")
Else
alert("Directory already exists: " & JPath)
End If

Const NORMAL_WINDOW = 1
Set objShell = CreateObject("Shell.Application")
objShell.ShellExecute "explorer.exe", JPath, , , NORMAL_WINDOW
window.close
End Function
</SCRIPT>
<BODY>
<!-- Customer Name Area -->
<TABLE><TD Style='width:101;'>Customer Name</TD><TD>
<INPUT Type='TextBox' ID='In1' Class='Tbx' Size='40' MAXLENGTH='128'>
<TD></TABLE>
<!-- Two Textboxes Start -->
<TABLE>
<!-- Invoice Number Area -->
<TD Style='width:100;'>Invoice Number</TD>
<TD><INPUT Type='TextBox' ID='In2' Class='Tbx' Size='5' MAXLENGTH='5'
Style='Margin-Right:15;' Title="Use Only The Last Five Digits
Of The Invoice Number"></TD>
<!-- Type Of Job Area -->
<TD Style='width:89;'>Type Of Job</TD>
<TD><INPUT Type='TextBox' ID='In3' Class='Tbx' Size='13' MAXLENGTH='128'><TD>
</TABLE>
<!-- Buttons Start -->
<BUTTON ID='Bn1' OnClick='MySubmit()'>Submit</BUTTON>
<BUTTON ID='Bn2' OnClick='window.close()'>Close</BUTTON>
<!-- Text Display For Script Messages -->
<DIV ID='Tx1' Style="visibility:hidden;Width:100%;Text-Align:Center;">
</DIV>
<!-- Pop Up Dialog -->
<DIV ID='Menu' Style="visibility:hidden;Position:Absolute;
Top:9;Left:9;Width:425;Height:195;Text-Align:Left;Padding:3pt;
Border-Left: 1px Solid; Border-Right: 2px Solid;
Border-Top: 1px Solid; Border-Bottom: 2px Solid;
filter:progid:DXImageTransform.Microsoft.Gradient
(StartColorStr='#EFEAE4',EndColorStr='#9E9E9E'); ">
<!-- Textboxes Customer Name To Edit -->
<TABLE><TD Style='width:101;'>Customer Name</TD><TD>
<INPUT Type='TextBox' ID='In1a' Class='Tbx' Size='40' MAXLENGTH='128'>
</TD></TABLE>
<!-- Textboxes Invoice Number To Edit -->
<TABLE><TD Style='width:101;'>Invoice Number</TD><TD>
<INPUT Type='TextBox' ID='In2a' Class='Tbx' Size='5' MAXLENGTH='128'>
</TD></TABLE>
<!-- Textboxes Type Of Job To Edit -->
<TABLE><TD Style='width:101;'>Type Of Job</TD><TD>
<INPUT Type='TextBox' ID='In3a' Class='Tbx' Size='13' MAXLENGTH='16'>
</TD></TABLE>
<!-- Text Option For Dialog -->
<TABLE Style='Width:100%;'><TD Style='Text-Align:Left;Padding:3;'>
Please verify the above information. Correct as necessary.
</TD></TABLE>
<!-- Button To Control Dialog -->
<TABLE Style='Width:100%;'><TD Style='Text-Align:Center;'>
<BUTTON OnClick="In1.value='' :In2.value='' :In3.value='' :A=1
In1.value=In1a.value :In2.value=In2a.value :In3.value=In3a.value
Menu.style.visibility = 'hidden' :JobBuilder()">Continue</BUTTON>
<BUTTON OnClick='window.close()'>Cancel</BUTTON>
</TD></TABLE>
</DIV>
</BODY>

0

Share this post


Link to post
Share on other sites

You should always place CreateObjects at the top of the script area this way it will be

able to be used by any function. The way you have it, you can only access that object

inside that function.

With all the Make Folders it would be better to make a function that only makes folders.

Example Tested Code, will create this folder on D:\Hey I Passed A Varible To A Function,

you could pass any path to that function and it checks to see if it does not exists, then creates

the folder path passed to the function.


Dim Fso :Set Fso = CreateObject("Scripting.FileSystemObject")

MkFldr("D:\Hey I Passed A Varible To A Function")

Function MkFldr(F)
If Not Fso.FolderExists(F) Then Fso.CreateFolder(F)
End Function

It would be a good idea to clean up your code first than add any changes.

0

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!


Register a new account

Sign in

Already have an account? Sign in here.


Sign In Now

  • Recently Browsing   0 members

    No registered users viewing this page.