Pin Folder to Windows Explorers Quick Access in VBA

[JackofAllWC]

I have tried to search this but haven't found a similar question. I wrote a macro that sets up a project folder with all the files and folders I needed but I would like to pin this to my quick access bar. Is there a way in VBA to add your folder path to Window Explorers Quick Access Bar? Thanks

[georgiboy]

Hi JackofAllWC,

Welcome to the forum.

Please see below for a method of doing this:

Sub PinToQA()
    Dim objShell As Object, oFoldItem As Object, item As Object
    Dim oFold As Object, objVerbs As Variant

    Set objShell = CreateObject("Shell.Application")
    Set oFold = objShell.Namespace("C:\Users\YourName\Desktop") ' parent folder of folder to pin
    Set oFoldItem = oFold.ParseName("Test") ' 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
End Sub

[JackofAllWC]

Good morning Georgiboy,

Thank you. This is exactly what I was looking to accomplish.

[Gasman]

Hi @georgiboy ,
Fairly old thread I know, but hoping you are still getting notifications.


I am trying to use your code to add back my QA folders automatically after I have to reset them with

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

However I am not getting anything for the ObjShell and hence OFold?
I have checked that I have correct values in strPath and strFolderQA

Sub PinToQA(strFolder As String)
    Dim objShell As Object, oFoldItem As Object, item As Object
    Dim oFold As Object, objVerbs As Variant
    Dim strPath As String, strFolderQA As String
    Dim iLen As Integer
    
    iLen = InStrRev(strFolder, "\")
    strPath = Left(strFolder, iLen)
    strFolderQA = Mid(strFolder, iLen + 1)
    
    Set objShell = CreateObject("Shell.Application")
    Set oFold = objShell.Namespace(strPath) ' parent folder of folder to pin
    Set oFoldItem = oFold.ParseName(strFolderQA) ' 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

I have now created a delete version in VBA.

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

[Gasman]

Solved it.

From this link https://stackoverflow.com/questions/...eturns-nothing

Your parameters must be submitted as Variant, not String

[georgiboy]

Hi Gasman,

I have notifications turned off but I check in often enough.

Glad you got it sorted.