Question

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

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

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

另外，我无法同时使用多个对象执行此手动过程，因此我最初希望解决方法（将它们全部复制到剪贴板然后打开资源管理器窗口）将无效。

我最好的解决方法是依次复制每个对象，ShellAndWait Explorer窗口，并指示用户粘贴文件，完成后关闭窗口，然后转到下一个对象。

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资源管理器不是自动化的，我们需要通过模拟键盘键间接命令它。

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

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

1 个答案: