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) :
However, sometimes the Network Location will map differently :
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?