Pin to Quick Access (1 Viewer)

[Gasman]

My Pin To Quick Access gets screwed up now and again.

I found this to delete it and then add them as I remember them.

del /f /s /q /a "%AppData%\Microsoft\Windows\Recent\AutomaticDestinations\f01b4d95cf55d32a.automaticDestinations-ms"

This was getting to be a PITA TBH.

So I did a little research and managed to cobble together the code below.

Hope it might help others.

Sub SetFoldersQA()
PinToQA ("F:\temp\DB")
PinToQA ("C:\Users\Paul\AppData")
PinToQA ("Z:\Downloads")
PinToQA ("F:\Temp")
End Sub

Sub ClearQA()
    Dim strCmd As String, strAppData As String

    strCmd = "del /f /s /q /a " & """%AppData%\Microsoft\Windows\Recent\AutomaticDestinations\f01b4d95cf55d32a.automaticDestinations-ms"""
    strAppData = Environ("AppData")
    strCmd = "%AppData%\Microsoft\Windows\Recent\AutomaticDestinations\f01b4d95cf55d32a.automaticDestinations-ms"
    strCmd = Replace(strCmd, "%AppData%", strAppData)
    'Debug.Print strCmd
    Kill strCmd
End Sub

Sub PinToQA(strFolder As String)
    Dim objShell As Object, oFoldItem As Object, item As Object
    Dim oFold As Object, objVerbs As Variant
    Dim vPath As Variant, vFolderQA As Variant
    Dim iLen As Integer
    
    iLen = InStrRev(strFolder, "\")
    vPath = Left(strFolder, iLen)
    vFolderQA = Mid(strFolder, iLen + 1)
    
    Set objShell = CreateObject("Shell.Application")
    Set oFold = objShell.Namespace(vPath) ' parent folder of folder to pin
    Set oFoldItem = oFold.ParseName(vFolderQA) ' folder to pin
    Set objVerbs = oFoldItem.Verbs
    For Each item In objVerbs
        If item.Name = "Pin to Quick access" Then
            item.DoIt
            Exit For
        End If
    Next
    Set item = Nothing
    Set oFoldItem = Nothing
    Set oFold = Nothing
    Set objShell = Nothing
End Sub

Garnered mainly from this link http://www.vbaexpress.com/forum/sho...orers-Quick-Access-in-VBA&p=423042#post423042