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.a utomaticDestinations-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.a utomaticDestinations-ms"""
strAppData = Environ("AppData")
strCmd = "%AppData%\Microsoft\Windows\Recent\AutomaticDestinations\f01b4d95cf55d32a.a utomaticDestinations-ms"
strCmd = Replace(strCmd, "%AppData%", strAppData)
Debug.Print strCmd
Kill strCmd


End Sub

[Gasman]

Solved it.

From this link https://stackoverflow.com/questions/31128248/excel-vba-shell-namespace-returns-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.