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:
Code:
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 FunctionCode:
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 IfCode:
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 SubCode:
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-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:
Code:
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
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, pdoFilesSay, 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.
