如何查找所有配置文件的所有快捷方式的所有目标路径？

Question

我正在尝试收集所有用户（用户y，x，z和public）的所有快捷方式信息。但是，目前我的代码只能搜索“公共”，而不能搜索“”中的各种其他用户文件夹。 C：\ Users“文件夹。

这是我正在使用的代码，但我需要它来搜索其他用户文件夹。

Option Explicit

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
sStartFolder = "C:\ProgramData\Microsoft\Windows\Start Menu\Programs"

Dim sArguments
Dim sDescription
Dim sHotKey
Dim sIconLocation
Dim sWindowStyle
Dim sWorkingDirectory
Dim sTargetPath

Dim oFSO
Dim oShell
Dim sStartFolder
Dim NewFile
Dim objFolder
Dim colFiles
Dim objFile
Dim sShortcut
Dim sExtention
Dim oShortcut
Dim Subfolder
Dim oFile
Dim sDateCreated

Const sError = "-"
Const sFile = "C:\Users\Public\AllUserShortcutList.txt"

Set NewFile = oFSO.CreateTextFile(sFile, True)

WriteToFile NewFile, _
    "Name" & vbTab & _
    "Target" & vbTab & _
    "Arguments" & vbTab & _
    "Working Directory" & vbTab & _
    "Icon Location" & vbTab & _
    "Hot Key" & vbTab & _
    "Shortcut Path" & vbTab & _
    "Description" & vbTab & _
    "WindowStyle" & vbTab & _
    "Command line to launch in DOS" & vbTab & _
    "Created On"

ShowFiles oFSO.GetFolder(sStartFolder)
ShowSubfolders oFSO.GetFolder(sStartFolder)
NewFile.Close

MsgBox "File Created:" & vbCrLf & vbCrLf & sFile

Sub ShowFiles (Folder)
    Set objFolder = oFSO.GetFolder(Folder)
    Set colFiles = objFolder.Files
    For Each objFile In colFiles
        If oFSO.GetExtensionName(LCase(objFile.Name)) <> "ini" Then
            GetShortcutDetails sStartFolder & "\" & objFile.Name

            Set oFile = oFSO.GetFile(sStartFolder & "\" & objFile.Name)
            sDateCreated = oFile.DateCreated

            WriteToFile NewFile, _
                objFile.Name & vbTab & _
                sTargetPath & vbTab & _
                sArguments & vbTab & _
                sWorkingDirectory & vbTab & _
                sIconLocation & vbTab & _
                sHotKey & vbTab & _
                sStartFolder  & vbTab & _
                sDescription & vbTab & _
                sWindowStyle & vbTab & _
                "START /WAIT """ & oFSO.GetBaseName(objFile.Name) & _
                """ """ & sTargetPath & """ " & sArguments & vbTab & _
                sDateCreated
        End If
    Next

    Set oFile = Nothing
End Sub

Sub ShowSubFolders(Folder)
    For Each Subfolder In Folder.SubFolders
        Set objFolder = oFSO.GetFolder(Subfolder.Path)
        Set colFiles = objFolder.Files
        For Each objFile In colFiles
            If oFSO.GetExtensionName(LCase(objFile.Name)) <> "ini" Then
                GetShortcutDetails Subfolder.Path & "\" & objFile.Name

                Set oFile = oFSO.GetFile(Subfolder.Path & "\" & objFile.Name)
                sDateCreated = oFile.DateCreated

                WriteToFile NewFile, _
                    objFile.Name & vbTab & _
                    sTargetPath & vbTab & _
                    sArguments & vbTab & _
                    sWorkingDirectory & vbTab & _
                    sIconLocation & vbTab & _
                    sHotKey & vbTab & _
                    Subfolder.Path & vbTab & _
                    sDescription & vbTab & _
                    sWindowStyle & vbTab & _
                    "START /WAIT """ & oFSO.GetBaseName(objFile.Name) & _
                    """ """ & sTargetPath & """ " & sArguments & vbTab & _
                    sDateCreated
            End if
        Next

        ShowSubFolders Subfolder
    Next
End Sub

Sub WriteToFile (oFile,sText)
    oFile.WriteLine(sText)
End Sub

Sub GetShortcutDetails (sFile)
    Dim sExtention
    Const sError = "-"

    sExtention = oFSO.GetExtensionName(LCase(sFile))

    If sExtention = "lnk" Then
        ' Find full path of shortcut
        sShortcut = oFSO.GetAbsolutePathName(sFile)
        'MsgBox sShortcut
        Set oShortcut = oShell.CreateShortcut(sShortcut)

        sTargetPath = oShortcut.TargetPath
        sArguments = oShortcut.Arguments
        sDescription = oShortcut.Description
        sHotKey = oShortcut.HotKey
        sIconLocation = oShortcut.IconLocation
        sWindowStyle = oShortcut.WindowStyle
        sWorkingDirectory = oShortcut.WorkingDirectory
    Else
        sTargetPath = sError
        sArguments = sError
        sDescription = sError
        sHotKey = sError
        sIconLocation = sError
        sWindowStyle = sError
        sWorkingDirectory = sError
    End If
End Sub