使用VB脚本映射网络位置时出现问题

时间:2018-08-31 14:56:10

标签: vbscript sharepoint-2013 webdav mapped-drive lnk

将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

问题如下:

有时“网络位置”将正确映射(已清除图像):

Network Location Mapped Normally

但是,有时网络位置会以不同的方式映射:

Network Location Mapped Abnormally

似乎没有任何导致这种异常的特殊条件,它似乎是随机发生的。

对我们来说,解决方案是重新映射网络位置,但是我们确实想找到根本原因。

经过检查,脚本确实添加了该“ target.lnk”,并且快捷方式确实转到了正确的位置。

有什么想法吗?

0 个答案:

没有答案