Advanced Search

Return to Snippet

Revision: 25680
at April 5, 2010 17:15 by karlhorky
Updated Code 
' 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

Revision: 25679
at April 5, 2010 17:13 by karlhorky
Updated Code 
' 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

Revision: 25678
at April 5, 2010 17:00 by karlhorky
Updated Code 
' 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

Revision: 25677
at April 5, 2010 16:54 by karlhorky
Initial Code 
' 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
Initial URL 

                                

                                                            

                                    

                                        

                                        Initial Description
                                        

                                    

                                    
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.

                                

                                                            

                                    

                                        

                                        Initial Title
                                        

                                    

                                    
WSH (VBScript): Windows 7 New File Context Menu Item

                                

                                                            

                                    

                                        

                                        Initial Tags
                                        

                                    

                                    
file, windows

                                

                                                            

                                    

                                        

                                        Initial Language
                                        

                                    

                                    
Visual Basic