创建像这样 powershell 脚本但在 VBS 中的网络位置

Question

I have this powershell function that creates network locations

function Add-NetworkLocation
{
    param(
        [string]$name,
        [string]$targetPath
    )
    
    # Get the basepath for network locations
    $shellApplication = New-Object -ComObject Shell.Application
    $nethoodPath = $shellApplication.Namespace(0x13).Self.Path

    # Créer l'emplacement réseau uniquement si le chemin local n'existe pas et que le chemin réseau existe
    if ((Test-Path $nethoodPath) -and !(Test-Path "$nethoodPath\$name") -and (Test-Path $targetPath))
    {
        # Create the folder
        $newLinkFolder = New-Item -Name $name -Path $nethoodPath -type directory

        # Create the ini file
        $desktopIniContent = @"
[.ShellClassInfo]
CLSID2={0AFACED1-E828-11D1-9187-B532F1E9575D}
Flags=2
ConfirmFileOp=1
"@
        $desktopIniContent | Out-File -FilePath "$nethoodPath\$name\Desktop.ini"

        # Créer le raccourci
        $shortcut = (New-Object -ComObject WScript.Shell).Createshortcut("$nethoodPath\$name\target.lnk")
        $shortcut.TargetPath = $targetPath
        $shortcut.IconLocation = "%SystemRoot%\system32\SHELL32.DLL, 85"
        $shortcut.Description = $targetPath
        $shortcut.WorkingDirectory = $targetPath
        $shortcut.Save()
        
        # Set attributes on the files & folders
        Set-ItemProperty "$nethoodPath\$name\Desktop.ini" -Name Attributes -Value ([IO.FileAttributes]::System -bxor [IO.FileAttributes]::Hidden)
        Set-ItemProperty "$nethoodPath\$name" -Name Attributes -Value ([IO.FileAttributes]::ReadOnly)
    } else {
        echo "Erreur : Un dossier avec ce nom existe deja"
    }
}

That creates real network location like this network location viewthat are automatically pinned in "This PC" and I want to do exactly the same thing with VBS.

But I've tried to use this code:

On Error Resume Next

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
strPath = strNetHood

DeleteFolder strPath

Set objWSHShell = CreateObject("Wscript.Shell")
Set objShell = CreateObject("Shell.Application")

Set objFolder = objShell.Namespace(NETHOOD)
Set objFolderItem = objFolder.Self
strNetHood = objFolderItem.Path
strPath = strNetHood

strPath = objFolderItem.Path & "\*.*"
On Error Resume Next
objFSO.DeleteFile strPath, true

strShortcutName = "Public"
strShortcutPath = "\\ads01\Public"

Set objShortcut = objWSHShell.CreateShortcut _
(strNetHood & "\" & strShortcutName & ".lnk")
objShortcut.TargetPath = strShortcutPath
objShortcut.Save

But it doesn't create the same kind of network locations and they're not pinned neither on "This Pc" nor in "Quick Access"

Does anybody have an idea how to do the same thing in VBS?

Answer 1

Your example worked ok for me? You might want to remove all your instances of 'On Error Resume Next' to see if something is throwing an error, or maybe an issue accessing '\ads01' etc.

Option Explicit

Const NETHOOD = &H13&

Dim objWshShell  : Set objWshShell = CreateObject("Wscript.Shell")
Dim objShell  : Set objShell = CreateObject("Shell.Application")
Dim strNetHood : strNetHood = objShell.Namespace(NETHOOD).Self.Path

Dim strShortcutName  : strShortcutName = "Example"
Dim strShortcutPath  : strShortcutPath = "C:\temp"

Dim objShortcut : Set objShortcut = objWshShell.CreateShortcut(strNetHood & "\" & strShortcutName & ".lnk")
objShortcut.TargetPath = strShortcutPath
objShortcut.Save

Set objShortcut = Nothing
Set objWshShell = Nothing
Set objShell = Nothing