/ Published in: Visual Basic
                    
                                        
A modification of Bill James' New Folder context menu script ( http://billsway.com/vbspage/ ), this script instead creates a "New File" item in the right click context menu of Directory Backgrounds. Upon running the New File item, you will be prompted for a filename that defaults to "new.txt". Once a valid filename has been entered (not an existing file) the script will then create the file. This allows the filename to be chosen in the dialog before any file creation has been executed. This has been tested to work on Windows 7 but may work on Vista as well.
Make the code below into a vbs file in the location you want it to be installed in (eg. C:\Windows\NewFile.vbs). To install the context menu item, run the vbs file. To uninstall the file, run the vbs file again.
                Make the code below into a vbs file in the location you want it to be installed in (eg. C:\Windows\NewFile.vbs). To install the context menu item, run the vbs file. To uninstall the file, run the vbs file again.
                            
                                Expand |
                                Embed | Plain Text
                            
                        
                        Copy this code and paste it in your HTML
' NewFile.vbs - Create right click context menu item for drives and
' directories (folders) allowing the creation of a new file.
' To Install or Un-install, double click this file.
' Requires WSH 2.0 +
' Original New Folder script ���© Bill James - [email protected] - rev 14/Nov/2001
' http://billsway.com/vbspage/
' New File Revision by Karl Horky
' v0.1 05 April 2010
Option Explicit
Dim fso, ws, Args, Title
Set fso = CreateObject("Scripting.FileSystemObject")
Set ws = CreateObject("Wscript.Shell")
Set Args = WScript.Arguments
Title = "Create New File Tool"
'Validate correct version for script.
If WScript.Version < 5.1 Then
ws.Popup "You need Windows Script Host 2.0 + to " & _
"run this script.", , Title, 0 + 48 + 4096
Call Cleanup
End If
'If script called directly, check setup & uninstall.
If Args.Count = 0 Then
Call Setup
End If
'Disable multiple drag and drop
If Args.Count > 1 Then
Call Cleanup
End If
Dim ParentFldr
'If a file was dragged to script, exit
On Error Resume Next
Set ParentFldr = fso.GetFile(Args(0))
If Err.Number = 0 Then
Call Cleanup
End If
Set ParentFldr = Nothing
On Error GoTo 0
Call MakeNewFile
Call Cleanup
Sub MakeNewFile
Dim NewFile, DirectoryPath, NewFilePath
NewFile = InputBox("Name for New File?", Title, "new.txt")
If NewFile = "" Then Call Cleanup
On Error Resume Next
DirectoryPath = fso.GetFolder(Args(0))
If Right(DirectoryPath,1)<>"\" Then DirectoryPath = DirectoryPath & "\"
NewFilePath = DirectoryPath & NewFile
If fso.FileExists(NewFilePath)=true Then
ws.Popup Chr(34) & NewFilePath & Chr(34) & " already exists.", ,Title, 0 + 48 + 4096
Call MakeNewFile
Else
fso.CreateTextFile NewFilePath
If Err.Number = 58 Then
Err.Clear:On Error GoTo 0
ws.Popup Chr(34) & NewFile & Chr(34) & " already exists.", ,Title, 0 + 48 + 4096
Call MakeNewFile
ElseIf Err.Number = 52 Then
Err.Clear:On Error GoTo 0
ws.Popup Chr(34) & NewFile & Chr(34) & " contains invalid character(s).", ,Title, 0 + 48 + 4096
Call MakeNewFile
End If
End If
End Sub
Sub Setup
'Write Reg Data if not existing or if path is invalid.
Dim p
On Error Resume Next
p = ws.RegRead("HKCR\Directory\Background\shell\NewFile (*)\command\")
p = Mid(p, 10, Len(p) - 15)
Err.Clear:On Error GoTo 0
If NOT fso.FileExists(p) Then
If ws.Popup("Do you want to Install the Folder context menu for " & _
"creating a new file?", , Title, 4 + 32 + 4096) <> 6 Then
Call Cleanup
End If
ws.RegWrite "HKCR\Directory\Background\shell\NewFile (*)\","&New File"
ws.RegWrite "HKCR\Directory\Background\shell\NewFile (*)\command\", _
"WScript " & chr(34) & WScript.ScriptFullName & _
chr(34) & " " & chr(34) & "%V" & chr(34)
ws.Popup "Setup complete. Right click on any Directory Background in Windows " & _
"Explorer and select the " & chr(34) & "New File" & chr(34) & _
" option to create a new file there." & vbcrlf & vbcrlf & _
"To Un-install, run this script again.", , Title, 64 + 4096
Else
If ws.Popup("Do you want to Un-install the Folder context menu for " & _
"creating a new file?", , Title, 4 + 32 + 4096) <> 6 Then
Call Cleanup
End If
ws.RegDelete "HKCR\Directory\Background\shell\NewFile (*)\command\"
ws.RegDelete "HKCR\Directory\Background\shell\NewFile (*)\"
ws.Popup "Un-install complete.", , Title, 64 + 4096
End If
Call Cleanup
End Sub
Sub Cleanup
Set ws = Nothing
Set fso = Nothing
Set Args = Nothing
WScript.Quit
End Sub
Comments
 Subscribe to comments
                    Subscribe to comments
                
                