OLEObject를 복사하여 폴더 또는 데스크톱에 붙여 넣기

Question

Excel 스프레드 시트에 OLEObjects (zip 파일)가 1 ~ 4 개 첨부되어 있습니다.

개체 중 하나를 마우스 오른쪽 단추로 클릭하고 바탕 화면이나 탐색기 창으로 이동 한 다음 마우스 오른쪽 단추로 클릭 한 다음 붙여 넣기를 클릭하여 해당 폴더에 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 탐색기가 자동화되어 있지 않으므로 키보드 키를 시뮬레이트하여 간접적으로 명령해야합니다.

나는 영업 이익은 약 2 년 전을 게시 4 월에 StackOverflow의 볼 마지막으로 주어진 폴더

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