[VB6, Vista+] Add the Windows Send To submenu to your popup menu

[fafalone]

So at first I set out to just duplicate the functionality, but then immediately saw the FOLDERID_SendTo special folder, and realized that it should be possible to add a fully functional SendTo menu. It's not just creating something similar, it actually implements the same Send To menu you get in Explorer- using shell interfaces to perform the actions the exact same way.

This project is a little high on the complexity scale, but not too bad.

The core parts of the code look like this:

Public psiSTChild() As IShellItem 'need to store the loaded SendTo items so they can be called when selected
Public Const widBaseST = 2800&
Public widSTMax As Long

Public Function GenerateSendToMenu() As Long
'it's the callers responsibility to call DestroyMenu()
Dim mii As MENUITEMINFOW
Dim i As Long, j As Long, k As Long
Dim hIcon As Long
Dim isiif As IShellItemImageFactory
Dim hMenu As Long
Dim lpCap As Long
Dim sCap As String
hMenu = CreateMenu()
Dim s1 As String, lp1 As Long
Dim psiSendTo As IShellItem
Dim nChild As Long
Dim pcl As Long
Dim penum As IEnumShellItems

On Error GoTo e0

Call SHGetKnownFolderItem(FOLDERID_SendTo, KF_FLAG_DEFAULT, 0&, IID_IShellItem, psiSendTo)
If (psiSendTo Is Nothing) = False Then
    psiSendTo.BindToHandler 0&, BHID_EnumItems, IID_IEnumShellItems, penum
    If (penum Is Nothing) = False Then
        ReDim psiSTChild(0)
        Do While (penum.Next(1&, psiSTChild(nChild), pcl) = S_OK)
            psiSTChild(nChild).GetDisplayName SIGDN_NORMALDISPLAY, lpCap
            sCap = LPWSTRtoStr(lpCap)
            Set isiif = psiSTChild(nChild)
            isiif.GetImage 16, 16, SIIGBF_ICONONLY, hIcon
            With mii
                .cbSize = Len(mii)
                .fMask = MIIM_ID Or MIIM_STRING Or MIIM_BITMAP
                .wID = (widBaseST + j)
                .cch = Len(sCap)
                .dwTypeData = StrPtr(sCap)
                .hbmpItem = hIcon
                Call InsertMenuItemW(hMenu, j, True, mii)
    
                Call DestroyIcon(hIcon)
                j = j + 1
            End With
            Set isiif = Nothing
            nChild = nChild + 1
            ReDim Preserve psiSTChild(nChild)
        Loop
    Else
        Debug.Print "GenerateSendToMenu->Failed to get enum obj"
    End If
Else
    Debug.Print "GenerateSendToMenu->Failed to get SendTo folder obj"
End If
widSTMax = j
GenerateSendToMenu = hMenu
Exit Function
e0:
Debug.Print "GenerateSendToMenu.Error->" & Err.Description & " (" & Err.Number & ")"
End Function

GenerateSendToMenu creates a submenu for a standard API popup menu. The shell items loaded from the SendTo folder are stored in a public array, so we can access them after a selection is made:

If idCmd Then
    Select Case idCmd
        Case widBaseST To (widBaseST + widSTMax)
            Dim lp As Long
            psiSTChild(idCmd - widBaseST).GetDisplayName SIGDN_NORMALDISPLAY, lp
            If MsgBox("Send to " & LPWSTRtoStr(lp) & "?", vbYesNo, "Confirm SendTo") = vbYes Then
                ExecSendTo (idCmd - widBaseST)
            End If
    End Select
End If

Finally, we use a technique you may recall from my Create Zip Files demo- dropping an IDataObject representing the files we're moving onto an IDropTarget belonging to the destination:

Private Sub ExecSendTo(nIdx As Long)
Dim pdt As IDropTarget
psiSTChild(nIdx).BindToHandler 0&, BHID_SFUIObject, IID_IDropTarget, pdt
If ((pdt Is Nothing) = False) And ((pdoFiles Is Nothing) = False) Then
    Dim dwEffect As Long
    dwEffect = DROPEFFECT_COPY Or DROPEFFECT_MOVE Or DROPEFFECT_LINK
    pdt.DragEnter pdoFiles, MK_LBUTTON, 0&, 0&, dwEffect
    pdt.Drop pdoFiles, MK_LBUTTON, 0&, 0&, dwEffect
End If
End Sub

As an added bonus, picking the files with IFileOpenDialog makes it super-easy to get the IDataObject for the files, pdoFiles.

Dim fod As New FileOpenDialog
Dim psiaRes As IShellItemArray
With fod
    .SetOptions FOS_ALLOWMULTISELECT Or FOS_DONTADDTORECENT
    .SetTitle "Choose files for SendTo..."
    .Show Me.hWnd
    .GetResults psiaRes
    If (psiaRes Is Nothing) = False Then
        psiaRes.BindToHandler 0&, BHID_DataObject, IID_IDataObject, pdoFiles
    End If
End With

Requirements
-Windows Vista or newer
-oleexp.tlb v4.0 or higher (only for IDE, doesn't need to be included with compiled exe)
-mIID.bas - included in the oleexp download

Extra Thoughts
Generate IDataObject from file list
If you want to get an IDataObject but just have a list of file paths, you can do it like this, where sSelFullPath is a string array of full paths to the files:

Public Declare Function SHCreateShellItemArrayFromIDLists Lib "shell32" (ByVal cidl As Long, ByVal rgpidl As Long, ppsiItemArray As IShellItemArray) As Long
Public Declare Function ILCreateFromPathW Lib "shell32" (ByVal pwszPath As Long) As Long


Dim psia As IShellItemArray
'Dim pdoFiles As oleexp.IDataObject - uncomment if you're not using the public pdoFiles from above
Dim apidl() As Long
Dim i As Long

ReDim apidl(0)
For i = 0 To UBound(sSelFullPath)
    ReDim Preserve apidl(i)
    apidl(i) = ILCreateFromPathW(StrPtr(sSelFullPath(i)))
Next i
Call SHCreateShellItemArrayFromIDLists(UBound(apidl) + 1, VarPtr(apidl(0)), psia)
psia.BindToHandler 0&, BHID_DataObject, IID_IDataObject, pdoFiles

Customizing the enumeration
Say, for example, you want to override the user preference for hidden files (in the pic up top, Desktop.ini is shown because my system is set to show all hidden/system files). There's two ways go about this. If you're targeting only Windows 8 and above, you can play around with the wonderful world of the IBindCtx parameter with STR_ENUM_ITEMS_FLAGS
Windows Vista and Windows 7 however, you're going to have to drop down to IShellFolder and use the .EnumObjects SHCONTF options. Doing it in VB with oleexp requires far less code than Raymond uses, if anyone is really interested I could write up the VB code.


twinBASIC 64bit compatible version at https://github.com/fafalone/MiscDemos