Visual Basic脚本在启动时不工作

Question

我有一个VB脚本，它有一个相应的.bat文件，把它放在“C:\users\default\appdata\roaming\microsoft\windows\start menu\programs\startup”文件夹中。但是，在启动时，脚本不会完全运行。脚本应该创建任务栏快捷方式，但没有为我列出的Office产品创建快捷方式。

下面是脚本：

    Option Explicit

Const CSIDL_COMMON_PROGRAMS = &H17
Const CSIDL_PROGRAMS = &H2
Const CSIDL_STARTMENU = &HB
Const CSIDL_CURRENT_USER_DESKTOP = &H10
Const CSIDL_PUBLIC_DESKTOP = &H19

Dim objShell, objFSO

Dim objCurrentUserStartFolder
Dim strCurrentUserStartFolderPath

Dim objCurrentUserDesktopFolder
Dim strCurrentUserDesktopFolderPath

Dim objAllUsersProgramsFolder
Dim strAllUsersProgramsPath

Dim objPublicDesktopFolder
Dim strPublicDesktopFolderPath

Dim objFolder
Dim objFolderItem
Dim colVerbs
Dim objVerb

Set objShell = CreateObject("Shell.Application")
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objCurrentUserStartFolder = objShell.NameSpace (CSIDL_STARTMENU)
strCurrentUserStartFolderPath = objCurrentUserStartFolder.Self.Path

Set objCurrentUserDesktopFolder = objShell.NameSpace (CSIDL_CURRENT_USER_DESKTOP)
strCurrentUserDesktopFolderPath = objCurrentUserDesktopFolder.Self.Path

Set objAllUsersProgramsFolder = objShell.NameSpace(CSIDL_COMMON_PROGRAMS)
strAllUsersProgramsPath = objAllUsersProgramsFolder.Self.Path

Set objPublicDesktopFolder = objShell.NameSpace (CSIDL_PUBLIC_DESKTOP)
strCurrentUserDesktopFolderPath = objPublicDesktopFolder.Self.Path

' - Remove pinned items -

'Internet Explorer
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Internet Explorer.lnk") Then
    Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs")
    Set objFolderItem = objFolder.ParseName("Internet Explorer.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Unpin from Taskbar" Then objVerb.DoIt
    Next
End If

'Google Chrome
If objFSO.FileExists(strAllUsersProgramsPath & "\Google Chrome\Google Chrome.lnk") Then
    Set objFolder = objShell.Namespace(strAllUsersProgramsPath & "\Google Chrome")
    Set objFolderItem = objFolder.ParseName("Google Chrome.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Unpin from Taskbar" Then objVerb.DoIt
    Next
End If

'Windows Explorer
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Accessories\Windows Explorer.lnk") Then
    Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs\Accessories")
    Set objFolderItem = objFolder.ParseName("Windows Explorer.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Unpin from Taskbar" Then objVerb.DoIt
    Next
End If

'Windows Media Player
If objFSO.FileExists(strAllUsersProgramsPath & "\Windows Media Player.lnk") Then
    Set objFolder = objShell.Namespace(strAllUsersProgramsPath)
    Set objFolderItem = objFolder.ParseName("Windows Media Player.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Unpin from Taskbar" Then objVerb.DoIt
    Next
End If

' - Pin to Taskbar -

'Mozilla Firefox
If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Mozilla Firefox.lnk") Then
    Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\")
    Set objFolderItem = objFolder.ParseName("Mozilla Firefox.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
    Next
End If

'Windows Explorer
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Accessories\Windows Explorer.lnk") Then
    Set objFolder = objShell.Namespace(strCurrentUserStartFolderPath & "\Programs\Accessories")
    Set objFolderItem = objFolder.ParseName("Windows Explorer.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
        If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
    Next
End If

'Microsoft Office Word
If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\Word 2013.lnk") Then
    Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\")
    Set objFolderItem = objFolder.ParseName("Word 2013.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
            If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
    Next
End If

'Microsoft Office Excel
If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\Excel 2013.lnk") Then
    Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\")
    Set objFolderItem = objFolder.ParseName("Excel 2013.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
            If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
    Next
End If

'Microsoft Office Powerpoint
If objFSO.FileExists("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\PowerPoint 2013.lnk") Then
    Set objFolder = objShell.Namespace("C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Microsoft Office\Microsoft Office 2013\")
    Set objFolderItem = objFolder.ParseName("PowerPoint 2013.lnk")
    Set colVerbs = objFolderItem.Verbs
    For Each objVerb in colVerbs
            If Replace(objVerb.name, "&", "") = "Pin to Taskbar" Then objVerb.DoIt
    Next
End If

' - Remove IE shortcuts from start menu -

'Internet Explorer
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Internet Explorer.lnk") Then
    objFSO.DeleteFile(strCurrentUserStartFolderPath & "\Programs\Internet Explorer.lnk")
End If

'Internet Explorer 64-bit
If objFSO.FileExists(strCurrentUserStartFolderPath & "\Programs\Internet Explorer (64-bit).lnk") Then
    objFSO.DeleteFile(strCurrentUserStartFolderPath & "\Programs\Internet Explorer (64-bit).lnk")
End If


' - Remove Thunderbird from current user desktop -
If objFSO.FileExists(strCurrentUserDesktopFolderPath & "\Mozilla Thunderbird.lnk") Then
    objFSO.DeleteFile(strCurrentUserDesktopFolderPath & "\Mozilla Thunderbird.lnk")
End If

' - Remove Thunderbird from public desktop -
If objFSO.FileExists(strPublicDesktopFolderPath& "\Mozilla Thunderbird.lnk") Then
    objFSO.DeleteFile(strPublicDesktopFolderPath& "\Mozilla Thunderbird.lnk")
End If

' - Remove Google Chrome from current user desktop -
If objFSO.FileExists(strCurrentUserDesktopFolderPath & "\Google Chrome.lnk") Then
    objFSO.DeleteFile(strCurrentUserDesktopFolderPath & "\Google Chrome.lnk")
End If

' - Remove Google Chrome from Public desktop -
If objFSO.FileExists(strPublicDesktopFolderPath & "\Google Chrome.lnk") Then
    objFSO.DeleteFile(strPublicDesktopFolderPath & "\Google Chrome.lnk")
End If

'Delete the script
DeleteSelf

Sub DeleteSelf()
        Dim objFSO
        'Create a File System Object
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        'Delete the currently executing script
        objFSO.DeleteFile WScript.ScriptFullName
        Set objFSO = Nothing
End Sub

下面是.bat文件：

mkdir "C:\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup"
copy /y SetShortcuts.vbs "C:\Users\Default\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup"

你知道为什么这行不通吗？

答：我想通了。我把文件路径名弄错了，因为如果计算机上安装了以前版本的Office的话，路径会不同。

Answer 1

默认用户配置文件是所有已创建用户的模板配置文件。无论何时创建新的用户配置文件，配置文件都是基于默认的用户配置文件构建的。

将文件复制到“%AllUsersProfile%\Microsoft\Windows\Start Menu\Programs\Startup”。