Trying to create a simple routine to modify a shortcut target path. I found an outdated shell reference that I was hoping to tweak.

It's assumed that the shortcut lives on the user's desktop. The plan is to call it like this ChangeShortcut "Test.lnk", "C:/users/environ$("username") & "/" & OneDrive-Personal/DBFolder/PMD_FE.accdb"

The following routine gets stuck at objfolder.ParseName(strNameOfShortCut) here is the complete routine:

Public Sub ChangeShortcut(strNameOfShortCut As String, strNewShortcutTarget As String)

    Const ALL_USERS_DESKTOP = &H19&

    Dim objShell As Object 'shell As Shell32.shell
    Dim objfolder As Object 'Shell32.folder
    Dim objfolderItem As Object 'Shell32.folderItem
    Dim objShortcut As Object 'Shell32.ShellLinkObject
    Dim objShellLink As Object
     
   
    Set objShell = CreateObject("Shell.Application")
   
    Set objfolder = objShell.Namespace(ALL_USERS_DESKTOP)
    If Not objfolder Is Nothing Then
        Set objfolderItem = objfolder.ParseName(strNameOfShortCut)
        If Not objfolderItem Is Nothing Then
            Set objShortcut = objfolderItem.GetLink
            If Not objShortcut Is Nothing Then
                objShortcut.Path = strNewShortcutTarget    'To Change
                objShortcut.Save
                MsgBox "Shortcut changed"
            Else
                MsgBox "Shortcut link within file not found"
            End If
        Else
            MsgBox "Shortcut file not found"
        End If
    Else
        MsgBox "Desktop folder not found"
    End If
   
End Sub

CodePudding user response：

This worked for me. For some reason I could not get ParseName to work, but looping the desktop items and checking for the name was ok.

Sub Tester()
    ChangeShortcut "Test.lnk", "C:\Temp\Docs"
End Sub


Public Sub ChangeShortcut(strNameOfShortCut As Variant, strNewShortcutTarget As Variant)
    Const DESKTOP = &H10&
    Dim objShell As Object 'shell As Shell32.shell
    Dim objfolder As Object 'Shell32.folder
    Dim objfolderItem As Object 'Shell32.folderItem
    Dim objShortcut As Object 'Shell32.ShellLinkObject
    Dim objShellLink As Object, itm As Object, ok As Boolean
    
    Set objShell = CreateObject("Shell.Application")
    Set objfolder = objShell.Namespace(DESKTOP)
    If Not objfolder Is Nothing Then
       For Each itm In objfolder.items
           If itm.Name = strNameOfShortCut Then
               ok = True
               Set objShortcut = itm.GetLink
               If Not objShortcut Is Nothing Then
                   objShortcut.Path = strNewShortcutTarget    'To Change
                   objShortcut.Save
                   ok = True
                   MsgBox "Shortcut changed"
               Else
                   MsgBox "Shortcut link within file not found"
               End If
           End If
       Next itm
       If Not ok Then MsgBox "Shortcut file not found"
    Else
       MsgBox "Desktop folder not found"
    End If
End Sub