复制一个OLEObject，并将其粘贴到一个文件夹（或桌面）

我在Excel电子表格中有1到4个附加的OLEObjects（zip文件）。

我可以手动右键单击>复制其中一个对象，然后转到桌面或资源pipe理器窗口，右键单击>粘贴它以在该文件夹中创build压缩文件。

据我所知，我不能用VBA自动化这个过程的Paste阶段。

此外，我不能同时执行多个对象的手动过程，所以我最初希望有一个解决方法（将它们全部复制到剪贴板，然后打开资源pipe理器窗口）将不起作用。

我最好的解决方法是依次复制每个对象，ShellAndWait浏览器窗口，并指示用户粘贴文件，完成后closures窗口，然后继续下一个对象。

Sub blunt_extract() If MsgBox("All attachments will be downloaded to your Documents folder", vbOKCancel Or vbInformation, "") = vbCancel Then Exit Sub Dim o As OLEObject, ws As Worksheet, rM As Range, ATT As String On Error Resume Next MkDir modSpecialFolders.SpecFolder(modSpecialFolders.CSIDL_PERSONAL) & "\CIRF\" MsgBox "For each attachment, Explorer will launch in the CIRF folder. Right-click > Paste the zip file, then close the Explorer window to continue", , "Save Attachment" Set ws = ThisWorkbook.Sheets(wsA) For Each o In ws.OLEObjects If Left(o.Name, 11) = "Attachment " Then o.Copy ShellAndWait "explorer " & modSpecialFolders.SpecFolder(modSpecialFolders.CSIDL_PERSONAL) & "\CIRF\", 0, vbNormalFocus, PromptUser MsgBox "Done pasting? Click OK to continue", , "Save Attachment" End If Next o On Error GoTo 0 End Sub 

任何build议进一步阅读，甚至解决scheme？

Answer 1

由于（不幸的是）Windows资源pipe理器不是自动的，我们需要通过模拟键盘键来间接地命令它。

我build议这个（testing）解决scheme将工作表中的embedded的OLE对象移动到给定的文件夹中

 Sub SaveOleObjectsTofolder(ws As Worksheet, folder As String) Shell "explorer " & folder, vbMaximizedFocus Dim o As OLEObject For Each o In ws.OLEObjects Application.Wait Now + TimeValue("00:00:01") ' necessary, give it a moment o.copy SendKeys "^v" ' paste in explorer Next SendKeys "%fc" ' close the explorer End Sub