excel - 复制 OLEObject，并将其粘贴到文件夹(或桌面)

Question

我在 Excel 电子表格中有 1 到 4 个附加的 OLEObject(zip 文件)。

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

据我所知，我无法使用 VBA 自动执行此过程的粘贴阶段。

此外，我不能同时对多个对象执行此手动过程，因此我最初希望的解决方法(将它们全部复制到剪贴板然后打开资源管理器窗口)将行不通。

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

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

有什么进一步阅读的建议，甚至是解决方案吗？

Answer 1

由于(不幸的是)Windows Explorer 不是自动化的，我们需要通过模拟键盘按键来间接命令它。

我建议使用此(经过测试的)解决方案将工作表中的嵌入式 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