Explorer検索

Module1.bas

Option Explicit

Declare Function ILCreateFromPathW& Lib "Shell32.dll" (ByVal pszPath&)
Declare Sub ILFree Lib "Shell32.dll" (ByVal pidl&)
Declare Function ILGetSize& Lib "Shell32.dll" (ByVal pidl&)
Private Declare _
        Function InitVariantFromBuffer Lib "propsys.dll" ( _
        ByVal pv As LongPtr, _
        ByVal cb As Long, _
        ByRef pvar As Variant _
      ) As Long
Private Declare PtrSafe Function SHGetIDispatchForFolder Lib "shdocvw.dll" (ByVal pidl As Long, arg2 As Any) As Long
Private Declare PtrSafe Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As LongPtr, ByVal nFolder As Long, ppidl As Any) As Long
Const CSIDL_PERSONAL = &H5
Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Const HWND_TOPMOST = -1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const SWP_SHOWWINDOW = &H40
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub test()

    Dim IE As Object
    Dim tmp&, pidl&, v, strPath$, hr&
    strPath = "D:\"

    'パスからアイテムIDリストへのポインタを得る
    pidl = ILCreateFromPathW(StrPtr(strPath))
    hr = InitVariantFromBuffer(pidl, ILGetSize(pidl), v)

    'Explorerをパスで検索
    Set IE = CreateObject("Shell.Application").Windows.findwindowSW(v, Empty, 1&, 0, 1&)

    If IE Is Nothing Then
        MsgBox "未起動なので起動します(｀･ω･´)ゞ"

        'Explorer起動
        hr = SHGetIDispatchForFolder(pidl, IE)
        SetWindowPos IE.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
    Else
        Sleep 500&
        SetWindowPos IE.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
    End If

    'pidl解放
    ILFree pidl

End Sub