Button to open File Explorer (actually Q-Dir) at Folder in list

[BBelly]

I have a page listing a number of 'summary' books located in the folder which they summarize. As this is on portable drives, I have to enter the drive letter in one cell whenever that changes (due to reconnecting elsewhere). I have a hyperlink† that opens that book. No problem so far.
This page includes the path to the folder in which that book is located.

I would like to have a 'solution' that opens the folder in File Explorer (but I would substitute 'Q-Dir' in this).
Ideally, If it was tied to the hyperlink it would be 'one stop shopping'
Next best would be a single button that uses the present cursor position (or a button at each hyperlink line that uses that information (or other file location data on that line) to open the folder. Trying to avoid ...
Next option would require me to create a custom button & macro to open the folder for each line. (today that is 114 unique locations ... ultimately it could be several thousand. I'd like to avoid having to create each solution individually, though I could see a way to create that unique code reasonably efficiently)

I can run a batch file to accomplish this ... I could create the unique batch file for each folder easily ... would just need a way to run that without having to open "run" and paste the batch to it.

† This hyperlink strips the folder name from the end of the path to create the 'friendly name' of the book located at F6: (not my creation!)
[=HYPERLINK(F6,LEFT(RIGHT(F6,LEN(F6)-SEARCH("$",SUBSTITUTE(F6,"\","$",LEN(F6)-LEN(SUBSTITUTE(F6,"\",""))))),LEN(RIGHT(F6,LEN(F6)-SEARCH("$",SUBSTITUTE(F6,"\","$",LEN(F6)-LEN(SUBSTITUTE(F6,"\",""))))))-5))]
So this takes the path ":\The Complete Data Location\Alpha Organizer(A,B,…XYZ)\Sub Alpha(AAA-ALL,ALM-AZZ)\Project Folder\Folder Summary.xlsx" to yield the 'friendly name' "Folder Summary",
Similarly, I can extract the path to the Folder alone.

I hope that presents my problem clearly! (??)

 

[ranman256]

Paste this code into a module, then its usage is: OpenNativeApp activecell.value

if the item in the cell is a URL, it will open in default explorer
if the item in the cell is the path to a Folder, it will open in file explorer
whatever path is in the cell/textbox will open in its native application

OpenNativeApp txtBox

#If Win64 Then      'Public Dclare PtrSafe Function
  Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As Long
#else
  Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpszOp As String, ByVal lpszFile As String, ByVal lpszParams As String, ByVal lpszDir As String, ByVal FsShowCmd As Long) As Long
  Private Declare Function GetDesktopWindow Lib "user32" () As Long
#End If


Const SW_SHOWNORMAL = 1
Const SE_ERR_FNF = 2&
Const SE_ERR_PNF = 3&
Const SE_ERR_ACCESSDENIED = 5&
Const SE_ERR_OOM = 8&
Const SE_ERR_DLLNOTFOUND = 32&
Const SE_ERR_SHARE = 26&
Const SE_ERR_ASSOCINCOMPLETE = 27&
Const SE_ERR_DDETIMEOUT = 28&
Const SE_ERR_DDEFAIL = 29&
Const SE_ERR_DDEBUSY = 30&
Const SE_ERR_NOASSOC = 31&
Const ERROR_BAD_FORMAT = 11&


Public Sub OpenNativeApp(ByVal psDocName As String)
Dim r As Long, msg As String

r = StartDoc(psDocName)
If r <= 32 Then
    'There was an error
    Select Case r
        Case SE_ERR_FNF
            msg = "File not found"
        Case SE_ERR_PNF
            msg = "Path not found"
        Case SE_ERR_ACCESSDENIED
            msg = "Access denied"
        Case SE_ERR_OOM
            msg = "Out of memory"
        Case SE_ERR_DLLNOTFOUND
            msg = "DLL not found"
        Case SE_ERR_SHARE
            msg = "A sharing violation occurred"
        Case SE_ERR_ASSOCINCOMPLETE
            msg = "Incomplete or invalid file association"
        Case SE_ERR_DDETIMEOUT
            msg = "DDE Time out"
        Case SE_ERR_DDEFAIL
            msg = "DDE transaction failed"
        Case SE_ERR_DDEBUSY
            msg = "DDE busy"
        Case SE_ERR_NOASSOC
            msg = "No association for file extension"
        Case ERROR_BAD_FORMAT
            msg = "Invalid EXE file or error in EXE image"
        Case Else
            msg = "Unknown error"
    End Select
'    MsgBox msg
End If
End Sub


Private Function StartDoc(psDocName As String) As Long
Dim Scr_hDC As Long

Scr_hDC = GetDesktopWindow()
StartDoc = ShellExecute(Scr_hDC, "Open", psDocName, "", "C:\", SW_SHOWNORMAL)
End Function