2

We have a strange issue when mapping a SharePoint 2013 WebDAV location to Windows 10 Network Locations.

We map these locations with a VB script:

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

The issue is as follows :

Sometimes the Network Location will map correctly (Sanitised image) :

Network Location Mapped Normally

However, sometimes the Network Location will map differently :

Network Location Mapped Abnormally

There doesn't seem to be any particular conditions that cause this anomaly, it seemingly occurs at random.

The solution for us is to re-map the Network Location, however we really want to find the root cause.

On inspection, the script does add this "target.lnk", and the shortcut does go to the correct place.

Any ideas?

OutOfThisPlanet
  • 336
  • 3
  • 17
  • Is there any way to shorten your [mcve]? I think it would make it easier to help you if the code is short and minimal and the issue is easy to reproduce. – Clijsters Sep 03 '18 at 12:09
  • Apologies, VB Script is not my forté so I can't help with that. I'm pretty sure the active part of the script is : Set objShortcut = objWSHShell.CreateShortcut(strShortcutFolder & "\target.lnk") – OutOfThisPlanet Sep 03 '18 at 14:44

0 Answers0