[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

[jpbro]

Hi fafalone, great demo! Just wondering if you have an example of how to use the Send To menu without requiring the user to pick the files? For example, if I already have a file or list of files that I know I want to send to a target?

I've been experimenting with using getting an IDataObject from a VB DataObject and swappinig out the GetData VTableEntry with a custom one and it works for certain SendTo items (e.g. Mail Recipient), but not others (e.g. Compressed zipped folder, Desktop)...some even crash the entire process (e.g. Skype). When I use your file-picker method all Send To targets work as expected so I'm missing something obviously.

Thanks for any assistance.

[jpbro]

I've gotten a bit closer - it looks like some SendTo targets have a different fomat ID for "Shell IDList Array" that what i get if I use RegisterClipboardFormat. I can test the results of GetClipboardFormatName for "Shell IDList Array" and then the following targets work: Desktop, Documents.

"Compressed (zipped) folder" almost works too - expect I get the message about the zip folder being empty.

The Skype target still crashes my EXE though - it is looking for CF_HDROP which is handled fine by the Mail Recipient, but maybe I'm doing something wrong - I will continue testing.

[jpbro]

Closer still - got the Skype/HDROP to work - I was improperly handling the STGMEDIUM pUnkForRelease.

Just the ZIP issue remains. I saw a post of yours elsewhere re: the empty zip error and it mentioned only passing 1 file first, then passing the rest of the files to circumvent it. Strange thing is that in my test app here, I'm only ever passing a single file. Sorry for spamming up this post - I've been working on this for over a day without much success, and it seems that posting here now has given me a bit of luck

[jpbro]

Obviously I didn't read your whole post! I just noticed the Extra Thoughts section.

[jpbro]

OK your code in the Extra Thoughts section worked perfectly, sorry to be a bother! Many thanks for all your work on this.

Quick note for anyone else stumbling across this code who needs to use the code in the Extra Thoughts section - if you are integrating it with the rest of fafalone's demo, make sure not to use the Dim pdoFiles As oleexp.IDataObject declaration in a Sub since it is also declared at the module level (the local version will override the module level one and you will get an error regarding missing objects).

[fafalone]

Made a note about the pdoFiles conflict, thanks.

There's a large number of ways to get an IDataObject... you can also get it from:
-IShellFolder.GetUIObjectOf, with relative pidls
-SHCreateFileDataObject/SHCreateDataObject, with absolute pidls
-From a VB DataObject via CopyMemory (see here)
-Directly from the clipboard, via the API OleGetClipboard
-From an individual IShellItem, with .BindToHandler BHID_DataObject

-------------------
Are you still having an issue with the zip files, or did that work without issue once you switched to the file list->idataobject code in the post?

[jpbro]

Hi fafalone, thanks for the additional information. With the code you provided in the Extra Thoughts section, every SendTo target I've tried seems to work flawlessly.

The only "issue" with the "Compressed (zipped) folder" is that it creates the ZIP file in the same folder as the file I am zipping which in my case turns out to be the %temp% folder and the user might not know it is there - do you know if there's a way to get the filename of the resultant zip file so I can move it to a user defined location when it is done? It's usually the name of a passed file with a .zip extension, but not sure if that would be the case if that filename already exists in the path (then it might get a (2) or similar appended)? I'd feel better if there was a guaranteed way to get the filename. Anyway, I'll do some of my own research too in case there's anything but I wanted to check with you in case you already knew.

[fafalone]

There's no way to get the file name directly... but what you could do is set up a shell notify that you start immediately beforehand*, and watch for SHCNE_CREATE messages. This should be extremely reliable, as it's unlikely more than one zip with your filename will be created in the few seconds we're looking at.

* - There's a new method of handling data that MSDN says should always be used as of Windows XP, see my demo: SHChangeNotifyRegister updated and corrected, including new delivery method