vbscript - 从 Windows 资源管理器上下文菜单调用 VBScript

Question

我想使用 VBScript 从 Windows 资源管理器中打开某种文件类型（DocuWorks aka *.xdw）。显然我可以编辑注册表以关联文件类型并将文件名作为参数（%1？）传递给脚本。

我想这样做的原因是因为我们共享驱动器上的某些文件在子文件夹层中的深度太深，以至于程序无法打开它们，我被要求想出一些东西来帮助用户解决这个问题。我的解决方案是在 Documents 中创建一个唯一文件夹，然后将文件复制到那里，打开它，然后删除该文件夹。

这是我编写的一些代码，但我从使用文件输入类型的 HTA 文件中获取文件名。如果我可以通过参数获取文件名，我将编辑代码以适应，但在这个阶段，我不知道该怎么做。

Option Explicit

Const dblHeight = 130
Const dblWidth = 700

Private sTempFolder
Private oFileScriptingObject

'Launches when the HTA file is opened.
Sub window_onLoad()
    Dim oWScript
    Dim iRandom
    
    'Set the HTA form location and size
    With Self
        
        .MoveTo Window.screen.Height / 2 - (dblHeight / 2), Window.screen.Width / 2 - (dblWidth / 2)
        
        .ResizeTo dblWidth, dblHeight
        
    End With

    'Use Wscript.Shell, create the unique folder path and name        
    Set oWScript = CreateObject("Wscript.Shell")
    
    sTempFolder = oWScript.SpecialFolders("mydocuments") & "\" & "Temp"
    
    For iRandom = 1 To 10
        
        Randomize
        
        sTempFolder = sTempFolder & Int((10 - 1 + 1) * Rnd + 1)
        
    Next
    
    'Use FileSystemObject to create the folder
    Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
    
    oFileScriptingObject.CreateFolder (sTempFolder)
    
    Set oWScript = Nothing
    
    Set oFileScriptingObject = Nothing
    
End Sub

'There's an Open button on the HTA form to call this
Sub OpenFile()
    Dim sTitle
    Dim sFilePath
    Dim sFileName
    Dim oShell
    
    sTitle = "Open DocuWorks File"

    'Get the file path from the file input on the form
    sFilePath = document.getElementById("file").Value
    
    If sFilePath = vbNullString Then
        
        MsgBox "Please use the Browse button to select a file", vbCritical, sTitle
        
        Exit Sub
        
    End If

    'Use Scripting.FileSystemObject to get the file name from the path
    'then copy the file to the unique folder. Also check the file extension (see note)
    'Note: Should have been to set the file input to filter and show DocuWorks files only
    'but for some reason "accept" attribute didn't work, maybe a HTA thing?
    Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
    
    With oFileScriptingObject
        
        sFileName = .GetFileName(sFilePath)
        
        If .GetExtensionName(sFileName) = "xdw" Then
            
            .CopyFile sFilePath, sTempFolder & "\"
            
            Set oShell = CreateObject("Shell.Application")
            
            oShell.Open sTempFolder & "\" & sFileName
            
        Else
            
            MsgBox "Please select a DocuWorks file.（.xdw）", vbCritical, sTitle
            
        End If
        
    End With
    
    Set oFileScriptingObject = Nothing
    
    Set oShell = Nothing
    
End Sub

'Delete the folder and cleanup
Sub window_onBeforeUnLoad()
    
    Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
    
    oFileScriptingObject.DeleteFolder sTempFolder
    
    Set oFileScriptingObject = Nothing
    
End Sub

'There's a Close button on the HTA form to call this
Sub CloseMe()
    
    Self.Close()
    
End Sub

如果我能够在注册表中关联文件类型，则无需检查扩展名。但是我真的需要帮助才能从 Windows 资源管理器上下文菜单中启动并运行它。

标签： vbscript