Vbscript 使用vb脚本映射网络位置的问题

将SharePoint 2013 WebDAV位置映射到Windows 10网络位置时，我们遇到了一个奇怪的问题

我们使用VB脚本映射这些位置：

dim SecurityGroup(1)
dim OneDriveName, OneDrivePath

'=========================================================================================
'Define Security Group
'=========================================================================================
SecurityGroup(0) = "Security Group 1"
SecurityGroup(1) = "Security Group 2"
'=========================================================================================
'Get current user account name used to map OneDrive
'=========================================================================================
Set wshShell = CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )

'=========================================================================================
' Add Network Place for users OneDrive
'=========================================================================================
OneDriveName = "OneDrive"
OneDrivePath = "https://mysite.domain.co.uk/personal/"+ strUserName +"/Documents"

CreateNetworkPlace OneDriveName, OneDrivePath

For Each strGroup In SecurityGroup
    if IsMember(strGroup) then
        CreateFunctionLibraryLocations(strGroup)
    end if
Next

Sub CreateFunctionLibraryLocations(strGroup)
    Select case strGroup
    Case "Security Group 1"     
        CreateNetworkPlace "Location 1", "https://teams.domain.co.uk/sites/SomeSite/Location1"
        CreateNetworkPlace "Location 2", "https://teams.domain.co.uk/sites/SomeSite/Location2"
        CreateNetworkPlace "Location 3", "https://teams.domain.co.uk/sites/SomeSite/Location3"
    Case "Security Group 2"
        CreateNetworkPlace "Location 1", "https://teams.domain.co.uk/sites/SomeSite/Location1"
        CreateNetworkPlace "Location 2", "https://teams.domain.co.uk/sites/SomeSite/Location2"
    End select
End Sub

WScript.Quit 

Sub RemoveNetworkPlace(strShortcutName, strShortcutPath)
If InStr(UCase(strShortcutPath), UCase("https")) = 0 Then
        strShortcutMod = Replace(strShortcutPath, "http://", "\\")
        strShortcutMod = Replace(strShortcutMod, "/", "\DavWWWRoot\", 1, 1)
    Else
        strShortcutMod = Replace(strShortcutPath, "https://", "\\")
        strShortcutMod = Replace(strShortcutMod, "/", "@SSL\DavWWWRoot\", 1, 1)
    End If 
    strShortcutMod = Replace(strShortcutMod, "/", "\")
    strShortcutMod = Replace(strShortcutMod, ":", "@")

    Const NETHOOD = &H13&
    Set objWSHShell = CreateObject("Wscript.Shell")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(NETHOOD)
    Set objFolderItem = objFolder.Self
    strNetHood = objFolderItem.Path
       Set objFSO = CreateObject("Scripting.FileSystemObject")
    strShortcutFolder = strNetHood & "\" & strShortcutName
    If objFSO.FolderExists(strShortcutFolder) Then
       'Set folder = objFSO.GetFile(strD)
        objFSO.DeleteFolder strShortcutFolder, True
    End If
End Sub

' the subroutine that does all the work
Sub CreateNetworkPlace(strShortcutName, strShortcutPath)
    If InStr(UCase(strShortcutPath), UCase("https")) = 0 Then
        strShortcutMod = Replace(strShortcutPath, "http://", "\\")
        strShortcutMod = Replace(strShortcutMod, "/", "\DavWWWRoot\", 1, 1)
    Else
        strShortcutMod = Replace(strShortcutPath, "https://", "\\")
        strShortcutMod = Replace(strShortcutMod, "/", "@SSL\DavWWWRoot\", 1, 1)
    End If 
    strShortcutMod = Replace(strShortcutMod, "/", "\")
    strShortcutMod = Replace(strShortcutMod, ":", "@")

    Const NETHOOD = &H13&
    Set objWSHShell = CreateObject("Wscript.Shell")
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(NETHOOD)
    Set objFolderItem = objFolder.Self
    strNetHood = objFolderItem.Path


    Set objFSO = CreateObject("Scripting.FileSystemObject")
    strShortcutFolder = strNetHood & "\" & strShortcutName
    If objFSO.FolderExists(strShortcutFolder) Then
        'wscript.echo strShortcutFolder & " already exists"
    Else
        Set objFolder = objFSO.CreateFolder(strShortcutFolder)        

        strDesktopIni = strShortcutFolder & "\Desktop.ini"
        If Not objFSO.FileExists(strDesktopIni) Then
            set fText = objFSO.OpenTextFile(strDesktopIni, 2, True) 
            fText.WriteLine "[.ShellClassInfo]"
            fText.WriteLine "CLSID2={0AFACED1-E828-11D1-9187-B532F1E9575D}"
            fText.WriteLine "Flags=2"
            fText.Close
        End If

        'set Desktop.ini with file attributes system & hidden
        Set fFile = objFSO.GetFile(strDesktopIni)
        fFile.Attributes = 6

        'set network place shortcut folder as read-only
        Set fFolder = objFSO.GetFolder(strShortcutFolder)
        fFolder.Attributes = 1

        'create the shortcut file target.lnk under the network place shortcut folder
        Set objShortcut = objWSHShell.CreateShortcut(strShortcutFolder & "\target.lnk")
        objShortcut.TargetPath = strShortcutMod
        objShortcut.Description = strShortcutPath
        objShortcut.Save
    End If
End Sub

Function IsMember(groupName)
    If IsEmpty(groupListD) then
        Set groupListD = CreateObject("Scripting.Dictionary")
        groupListD.CompareMode = 1
        ADSPath = EnvString("userdomain") & "/" & EnvString("username")
        Set userPath = GetObject("WinNT://" & ADSPath & ",user")
        For Each listGroup in userPath.Groups
            groupListD.Add listGroup.Name, "-"
        Next
    End if
    IsMember = CBool(groupListD.Exists(groupName))
End Function

Function EnvString(variable)
Set objWSHShell = CreateObject("Wscript.Shell")
    variable = "%" & variable & "%"
    EnvString = objWSHShell.ExpandEnvironmentStrings(variable)
End Function

问题如下:

有时网络位置将正确映射（净化图像）：

但是，有时网络位置的映射会有所不同：

似乎没有任何特殊情况导致这种异常，它似乎是随机发生的

我们的解决方案是重新映射网络位置，但我们确实希望找到根本原因

检查时，脚本确实添加了这个“target.lnk”，并且快捷方式确实到达了正确的位置

---

有什么想法吗？

有没有办法缩短你的时间？我认为如果代码简短，并且问题易于重现，那么帮助您会更容易。抱歉，VB脚本不是我的堡垒，因此我无法帮助您。我很确定脚本的活动部分是：Set objShortcut=objWSHShell.CreateShortcut（strShortcutFolder&“\target.lnk”）