VBScript - Emulate Windows 95 Powertoys SendTo

Whenever I use a new computer I always add the SendTo extensions using the Windows 95 Powertoys.
http://www.microsoft.com/windows95/d...et/Default.asp

NOTE: Although they are not officially supported, the Powertoys DO work on all versions of Windows (not sure about Vista).

Unfortunately if you are on a computer with only user rights you can't install them.
These files emulate the SendTo actions with VBscripts.

SendTo Any Folder lets you right-click on any file then copy/move it to the directory you specify.
SendTo Clipboard AsName puts the absolute pathname of the file you have clicked on into the clipboard.

To 'install' these save them as .vbs files and put them in your SendTo folder
C:\Documents and Settings\username\SendTo

Code:

---

'VBScript to Emulate Windows 95 Powertoy SendTo Any Folder
    Dim fso, Package, oShell, sExt, sFileFolder, iMoveCopy, Test4, Top, PkgName2
    Dim Namer, oFolder, oFolderItem, fldrs, destination, PkgName, selected
    Const ssfDESKTOP                = 0    'Microsoft Windows Desktop—virtual folder that is the root of the namespace. (value = 0)
 
    destination = " "
    Top = WScript.Arguments.Count
    For I = 0 To (Top - 1)
        Package = WScript.Arguments.Item(I)
        Set fso = CreateObject("Scripting.FileSystemObject")
        PkgName = fso.GetBaseName(Package)
        PkgName2 = fso.GetFileName(Package)
        Set oShell = CreateObject("Shell.Application")
        '
        If destination = " " Then
            '

            On Error Resume Next
            Set oFolder = oShell.BrowseForFolder(&H0, "Select a Destination Folder", &H11, ssfDESKTOP)
            Set oFolderItem = oFolder.Items.Item
            Set selected = fso.GetFolder(oFolderItem.Path)
            If selected.IsRootFolder Then
                Set fldrs = fso.GetDrive(selected.Drive)
            Else
                Set fldrs = fso.GetFolder(oFolderItem.Path)
            End If
            '
            If Err.Number <> 0 Then
                Set oShell = Nothing
                Set fso = Nothing
                WScript.Quit
            End If
            '
            destination = fldrs

        End If

        sExt = fso.GetExtensionName(Package)
        If Len(sExt) > 0 Then
            sFileFolder = "aFile"
            iMoveCopy = MsgBox ("Would you like to MOVE the file " & vbCRLF & PkgName2 & "?" & vbCRLF & vbCRLF & _
            "Click YES to Move or NO to Copy",vbYesNoCancel + vbDefaultButton2 + vbQuestion,"Send file " &  fso.GetAbsolutePathName(Package))
        Else
            sFileFolder = "aFolder"
            If fso.GetDriveName(destination) <> fso.GetDriveName(Package) Then
                iMoveCopy = vbNo
                MsgBox "Since the destination is on a different drive, the folder can only be copied"
            Else
                iMoveCopy = MsgBox ("Would you like to MOVE the folder " & vbCRLF & PkgName & "?" & vbCRLF & vbCRLF & _
                "Click YES to Move or NO to Copy",vbYesNoCancel + vbDefaultButton2 + vbQuestion,"Send folder")
            End If
        End If
        '
        If iMoveCopy = vbNo Then
            If sFileFolder="aFile" and fso.FileExists (destination & "\" & PkgName & "." & sExt) Then
                MsgBox ("Can't overwrite" & vbCRLF & "File named " & PkgName & "." & sExt & " already found at destination")
            End If
            If sFileFolder="aFolder" and fso.FolderExists (destination & "\" & PkgName) Then
                MsgBox ("Can't overwrite" & vbCRLF & "Folder named " & PkgName & " already found at destination")
            End If
            If sFileFolder = "aFile" Then
                fso.CopyFile Package, destination & "\" & PkgName & "." & sExt, False
            End If
            If sFileFolder = "aFolder" Then
                fso.CopyFolder Package, destination & "\" & PkgName, False
            End If
            '
        Else If iMoveCopy=vbYes Then
            If sFileFolder="aFile" and fso.FileExists (destination & "\" & PkgName & "." & sExt) Then
                MsgBox ("Can't overwrite" & vbCRLF & "File named " & PkgName & "." & sExt & " already found at destination")
            End If
            If sFileFolder="aFolder" and fso.FolderExists (destination & "\" & PkgName) Then
                MsgBox ("Can't overwrite" & vbCRLF & "Folder named " & PkgName & " already found at destination")
            End If

            If sFileFolder = "aFile" Then
                fso.MoveFile Package, destination & "\" & PkgName & "." & sExt
            End If
            If sFileFolder = "aFolder" Then
                fso.MoveFolder Package, destination & "\" & PkgName
            End If
        End If
    End If
Next
Set fso = Nothing
Set oShell = Nothing

---

Code:

---

'VBScript to emulate Windows 95 Powertoys SendTo Clipboard As Name
'Puts the full path and name of a file on the clipboard
If wscript.arguments.Count = 0 Then
    wscript.Quit
End If
With CreateObject("InternetExplorer.Application")
    .navigate "about:blank"
    While .busy: Wend
    .document.parentwindow.clipboardData.setData "Text", wscript.arguments.Item(0)
    .Quit
End With

---

I found the code somewhere on the web and tidied it up slightly so credit is not all mine. :)